diff --git a/LeanPool/PlanarMidpoint.lean b/LeanPool/PlanarMidpoint.lean new file mode 100644 index 0000000000..52e9f1739e --- /dev/null +++ b/LeanPool/PlanarMidpoint.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.PlanarMidpoint.MidpointRigidity +public import LeanPool.PlanarMidpoint.TensorSemantics +public import LeanPool.PlanarMidpoint.FiveDirections + +/-! +# Planar Euclidean dual-geodesic midpoint rigidity + +Source: arxiv:2609.07551, url:https://github.com/JD-Jones-ASES/PlanarMidpoint/tree/f277b89a3b0db20872101fd61580ecced748e7c1 +Authors: JD Jones +Status: verified +Main declarations: `PlanarMidpoint.planar_dual_midpoint_rigidity` +Tags: differential-geometry, ordinary-differential-equations, functional-equations +MSC: 53B12, 39B22 +-/ + +/-! Planar Euclidean midpoint rigidity and its differentiable core. -/ + +@[expose] public section + +/- +Original upstream MIT notice, retained for the Apache-2.0 adaptation: + +MIT License + +Copyright (c) 2026 JD Jones + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +-/ diff --git a/LeanPool/PlanarMidpoint/Algebra.lean b/LeanPool/PlanarMidpoint/Algebra.lean new file mode 100644 index 0000000000..9e9150d2b7 --- /dev/null +++ b/LeanPool/PlanarMidpoint/Algebra.lean @@ -0,0 +1,509 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.NormNum + +/-! Exact polynomial certificates for the planar obstruction kernel. -/ + +@[expose] public section +namespace PlanarMidpoint.Algebra + +/-- The ten quartic coefficient equations, in immutable derivative order +`(aₓ,bₓ,cₓ,dₓ,aᵧ,bᵧ,cᵧ,dᵧ)`. -/ +def Kernel (a b c d : ℝ) (z : Fin 8 → ℝ) : Prop := + 3 * a * z 0 - 2 * b * z 1 + 5 * b * z 4 = 0 ∧ + 4 * b * z 0 + 8 * b * z 5 + z 1 * (10 * a - 6 * c) + z 4 * (-2 * a + 10 * c) = 0 ∧ + 2 * b * z 3 + 5 * b * z 6 + c * z 0 + 14 * c * z 5 + z 1 * (16 * b - 4 * d) + z 2 * (7 * a - 4 * + c) + z 4 * (-6 * b + 5 * d) = 0 ∧ + 2 * b * z 7 + 6 * c * z 1 + 2 * c * z 3 - 4 * c * z 4 + z 2 * (12 * b - 4 * d) + z 5 * (-4 * b + + 6 * d) + z 6 * (2 * a + 6 * c) = 0 ∧ + 5 * c * z 2 - 4 * c * z 5 + 2 * c * z 7 + z 6 * (2 * b + d) = 0 ∧ + 2 * b * z 0 - 4 * b * z 2 + 5 * b * z 5 + z 1 * (a + 2 * c) = 0 ∧ + -4 * b * z 3 + 2 * b * z 4 + 6 * b * z 6 + 2 * c * z 0 + z 1 * (6 * b + 2 * d) + z 2 * (6 * a - + 4 * c) + z 5 * (-4 * a + 12 * c) = 0 ∧ + 14 * b * z 2 + b * z 7 + 5 * c * z 1 + 2 * c * z 4 + z 3 * (5 * a - 6 * c) + z 5 * (-4 * b + 7 * + d) + z 6 * (-4 * a + 16 * c) = 0 ∧ + 8 * c * z 2 + 4 * c * z 7 + z 3 * (10 * b - 2 * d) + z 6 * (-6 * b + 10 * d) = 0 ∧ + 5 * c * z 3 - 2 * c * z 6 + 3 * d * z 7 = 0 + + +theorem tracefree_0 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 0 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 36 * ((a ^ 2 + b ^ 2) ^ 2 * z 0) = 0 := by + linear_combination (12 * a ^ 3 - 4 * a * b ^ 2) * h0 + (5 * a ^ 2 * b - 3 * b ^ 3) * h1 + (-8 + * b ^ 3) * h3 + (16 * a * b ^ 2) * h4 + (56 * a ^ 2 * b + 24 * b ^ 3) * h5 + (24 * a * b ^ + 2) * h6 + (16 * b ^ 3) * h7 + (-8 * a * b ^ 2) * h8 + linarith only [he] + +theorem tracefree_1 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 1 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 36 * ((a ^ 2 + b ^ 2) ^ 2 * z 1) = 0 := by + linear_combination (20 * a ^ 2 * b + 4 * b ^ 3) * h0 + (16 * a * b ^ 2) * h1 + (-14 * a ^ 2 * + b + 2 * b ^ 3) * h2 + (-16 * a * b ^ 2) * h3 + (-16 * b ^ 3) * h4 + (-36 * a ^ 3 - 36 * a + * b ^ 2) * h5 + (a ^ 2 * b + b ^ 3) * h6 + linarith only [he] + +theorem tracefree_2 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 2 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 252 * ((a ^ 2 + b ^ 2) ^ 2 * z 2) = 0 := by + linear_combination (-28 * a ^ 3 + 84 * a * b ^ 2) * h0 + (-78 * a ^ 2 * b + 42 * b ^ 3) * h1 + + (112 * a ^ 3 - 16 * a * b ^ 2) * h2 + (143 * a ^ 2 * b + 7 * b ^ 3) * h3 + (144 * a * b ^ + 2) * h4 + (-52 * a ^ 2 * b - 84 * b ^ 3) * h5 + (-98 * a ^ 3 - 74 * a * b ^ 2) * h6 + (-30 + * a ^ 2 * b - 14 * b ^ 3) * h7 + (-8 * a * b ^ 2) * h8 + linarith only [he] + +theorem tracefree_3 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 3 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 5292 * ((a ^ 2 + b ^ 2) ^ 2 * z 3) = 0 := by + linear_combination (182 * a ^ 2 * b + 2534 * b ^ 3) * h0 + (-462 * a ^ 3 - 3278 * a * b ^ 2) * + h1 + (4004 * a ^ 2 * b + 724 * b ^ 3) * h2 + (-1260 * a ^ 3 + 2484 * a * b ^ 2) * h3 + + (-1134 * a ^ 2 * b + 3074 * b ^ 3) * h4 + (-1092 * a ^ 3 + 764 * a * b ^ 2) * h5 + (-3745 + * a ^ 2 * b - 2353 * b ^ 3) * h6 + (252 * a ^ 3 - 676 * a * b ^ 2) * h7 + (-464 * b ^ 3) * + h8 + linarith only [he] + +theorem tracefree_4 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 4 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 252 * ((a ^ 2 + b ^ 2) ^ 2 * z 4) = 0 := by + linear_combination (196 * a ^ 2 * b + 84 * b ^ 3) * h0 + (-21 * a ^ 3 + 83 * a * b ^ 2) * h1 + + (-84 * a ^ 2 * b + 12 * b ^ 3) * h2 + (-88 * a * b ^ 2) * h3 + (-80 * b ^ 3) * h4 + (-336 + * a ^ 3 - 304 * a * b ^ 2) * h5 + (-42 * a ^ 2 * b - 18 * b ^ 3) * h6 + (-16 * a * b ^ 2) + * h7 + (-8 * b ^ 3) * h8 + linarith only [he] + +theorem tracefree_5 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 5 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 252 * ((a ^ 2 + b ^ 2) ^ 2 * z 5) = 0 := by + linear_combination (-28 * a ^ 3 + 84 * a * b ^ 2) * h0 + (-54 * a ^ 2 * b + 42 * b ^ 3) * h1 + + (70 * a ^ 3 - 10 * a * b ^ 2) * h2 + (92 * a ^ 2 * b + 28 * b ^ 3) * h3 + (48 * a * b ^ 2) + * h4 + (-148 * a ^ 2 * b - 84 * b ^ 3) * h5 + (-77 * a ^ 3 - 125 * a * b ^ 2) * h6 + (-24 + * a ^ 2 * b - 56 * b ^ 3) * h7 + (16 * a * b ^ 2) * h8 + linarith only [he] + +theorem tracefree_6 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 6 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 5292 * ((a ^ 2 + b ^ 2) ^ 2 * z 6) = 0 := by + linear_combination (-1120 * a ^ 2 * b + 1232 * b ^ 3) * h0 + (-210 * a ^ 3 - 3002 * a * b ^ 2) + * h1 + (3584 * a ^ 2 * b + 352 * b ^ 3) * h2 + (-693 * a ^ 3 + 2979 * a * b ^ 2) * h3 + + (-756 * a ^ 2 * b + 3356 * b ^ 3) * h4 + (1428 * a ^ 3 + 3188 * a * b ^ 2) * h5 + (-2464 * + a ^ 2 * b - 1144 * b ^ 3) * h6 + (-126 * a ^ 3 - 1006 * a * b ^ 2) * h7 + (-440 * b ^ 3) * + h8 + linarith only [he] + +theorem tracefree_7 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) : (a ^ 2 + b ^ 2) ^ 2 * z 7 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 252 * ((a ^ 2 + b ^ 2) ^ 2 * z 7) = 0 := by + linear_combination (14 * a ^ 3 - 98 * a * b ^ 2) * h0 + (82 * a ^ 2 * b - 126 * b ^ 3) * h1 + + (-140 * a ^ 3 + 164 * a * b ^ 2) * h2 + (-190 * a ^ 2 * b + 210 * b ^ 3) * h3 + (-126 * a + ^ 3 - 622 * a * b ^ 2) * h4 + (-132 * a ^ 2 * b + 252 * b ^ 3) * h5 + (91 * a ^ 3 - 197 * + a * b ^ 2) * h6 + (24 * a ^ 2 * b - 168 * b ^ 3) * h7 + (96 * a * b ^ 2) * h8 + linarith only [he] + +theorem normalized_0 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 0 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 10420830 * (b * z 0) = 0 := by + linear_combination (-360225648 * a ^ 4 * b + 1681735992 * a ^ 3 * b - 943939296 * a ^ 2 * b ^ + 3 - 2882847528 * a ^ 2 * b + 1644487992 * a * b ^ 3 + 2157916062 * a * b - 583713648 * b ^ + 5 - 658865376 * b ^ 3 - 593105268 * b) * h0 + (-1050840 * a ^ 5 + 6246660 * a ^ 4 - + 337333680 * a ^ 3 * b ^ 2 - 14419860 * a ^ 3 + 1113246252 * a ^ 2 * b ^ 2 + 16288020 * a ^ + 2 - 336282840 * a * b ^ 4 - 1272694320 * a * b ^ 2 - 9048900 * a + 231671592 * b ^ 4 + + 505465773 * b ^ 2 + 1984920) * h1 + (727176672 * a ^ 4 * b - 2787241872 * a ^ 3 * b + + 560401344 * a ^ 2 * b ^ 3 + 3595718828 * a ^ 2 * b - 1073833872 * a * b ^ 3 - 1734384818 * + a * b - 166775328 * b ^ 5 + 534384060 * b ^ 3 + 198731190 * b) * h2 + (-2732184 * a ^ 5 + + 15587460 * a ^ 4 + 1447207632 * a ^ 3 * b ^ 2 - 34280736 * a ^ 3 - 4237691892 * a ^ 2 * b + ^ 2 + 36697668 * a ^ 2 + 1449939816 * a * b ^ 4 + 2961506340 * a * b ^ 2 - 19242048 * a - + 1701791352 * b ^ 4 - 159155379 * b ^ 2 + 3969840) * h3 + (-1094127696 * a ^ 4 * b + + 2924299752 * a ^ 3 * b - 176863392 * a ^ 2 * b ^ 3 - 1602110688 * a ^ 2 * b - 465268248 * + a * b ^ 3 - 636203578 * a * b + 917264304 * b ^ 5 - 149375304 * b ^ 3 + 402424680 * b) * + h4 + (-4623696 * a ^ 5 + 17560704 * a ^ 4 + 2002144608 * a ^ 3 * b ^ 2 - 23947476 * a ^ 3 + - 3549022632 * a ^ 2 * b ^ 2 + 12715164 * a ^ 2 + 2006768304 * a * b ^ 4 + 1427467716 * a + * b ^ 2 - 712236 * a - 921975336 * b ^ 4 + 39517278 * b ^ 2 - 992460) * h5 + (-910652184 * + a ^ 4 * b + 3399215100 * a ^ 3 * b - 368632368 * a ^ 2 * b ^ 3 - 4169323738 * a ^ 2 * b + + 1592687100 * a * b ^ 3 + 1777893382 * a * b + 542019816 * b ^ 5 - 1317640854 * b ^ 3 - + 97132560 * b) * h6 + (840672 * a ^ 5 - 5254200 * a ^ 4 - 892270656 * a ^ 3 * b ^ 2 + + 12761868 * a ^ 3 + 2305169760 * a ^ 2 * b ^ 2 - 15108744 * a ^ 2 - 893111328 * a * b ^ 4 - + 1246932708 * a * b ^ 2 + 8745324 * a + 1341975960 * b ^ 4 - 172722348 * b ^ 2 - 1984920) * + h7 + (543701160 * a ^ 4 * b - 1446317220 * a ^ 3 * b + 752170320 * a ^ 2 * b ^ 3 + + 774906942 * a ^ 2 * b - 1315949220 * a * b ^ 3 + 336202508 * a * b + 208469160 * b ^ 5 + + 342064674 * b ^ 3 - 205678410 * b) * h8 + (2942352 * a ^ 5 - 16953552 * a ^ 4 - 217603296 + * a ^ 3 * b ^ 2 + 37374876 * a ^ 3 + 893024616 * a ^ 2 * b ^ 2 - 39569964 * a ^ 2 - + 220545648 * a * b ^ 4 - 862587164 * a * b ^ 2 + 20176128 * a + 202266168 * b ^ 4 + + 192824994 * b ^ 2 - 3969840) * h9 + linarith only [he] + +theorem normalized_1 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 1 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 212670 * (b * z 1) = 0 := by + linear_combination (1778496 * a ^ 4 - 7659228 * a ^ 3 + 3185664 * a ^ 2 * b ^ 2 + 12228498 * a + ^ 2 - 5603868 * a * b ^ 2 - 8593296 * a + 1407168 * b ^ 4 + 2276424 * b ^ 2 + 2245530) * + h0 + (2165184 * a ^ 3 * b - 6039690 * a ^ 2 * b + 2165184 * a * b ^ 3 + 5669859 * a * b - + 1293546 * b ^ 3 - 1795353 * b) * h1 + (-3556992 * a ^ 4 + 12354296 * a ^ 3 - 3154944 * a ^ + 2 * b ^ 2 - 14655776 * a ^ 2 + 4917368 * a * b ^ 2 + 6606982 * a + 402048 * b ^ 4 - + 2001716 * b ^ 2 - 748510) * h2 + (-5752896 * a ^ 3 * b + 15455334 * a ^ 2 * b - 5752896 * + a * b ^ 3 - 10140309 * a * b + 5327622 * b ^ 3 + 821100 * b) * h3 + (5335488 * a ^ 4 - + 12306708 * a ^ 3 + 3124224 * a ^ 2 * b ^ 2 + 5550926 * a ^ 2 + 511788 * a * b ^ 2 + + 2734824 * a - 2211264 * b ^ 4 - 207808 * b ^ 2 - 1497020) * h4 + (-7546752 * a ^ 3 * b + + 13514484 * a ^ 2 * b - 7546752 * a * b ^ 3 - 5708958 * a * b + 3692724 * b ^ 3 - 46104 * + b) * h5 + (4446240 * a ^ 4 - 14998246 * a ^ 3 + 3139584 * a ^ 2 * b ^ 2 + 16849537 * a ^ 2 + - 7867270 * a * b ^ 2 - 6671786 * a - 1306656 * b ^ 4 + 4637668 * b ^ 2 + 374255) * h6 + + (3959040 * a ^ 3 * b - 8655384 * a ^ 2 * b + 3959040 * a * b ^ 3 + 3963276 * a * b - + 4215192 * b ^ 3 + 514080 * b) * h7 + (-2667744 * a ^ 4 + 6153354 * a ^ 3 - 3170304 * a ^ 2 + * b ^ 2 - 2775463 * a ^ 2 + 4403946 * a * b ^ 2 - 1367412 * a - 502560 * b ^ 4 - 1117036 * + b ^ 2 + 748510) * h8 + (-371328 * a ^ 3 * b - 938948 * a ^ 2 * b - 371328 * a * b ^ 3 + + 2401926 * a * b + 2428 * b ^ 3 - 909160 * b) * h9 + linarith only [he] + +theorem normalized_2 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 2 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 3473610 * (b * z 2) = 0 := by + linear_combination (69353568 * a ^ 4 * b - 313823472 * a ^ 3 * b + 180179136 * a ^ 2 * b ^ 3 + + 521835968 * a ^ 2 * b - 306911472 * a * b ^ 3 - 379450382 * a * b + 110825568 * b ^ 5 + + 118792656 * b ^ 3 + 102084318 * b) * h0 + (-700560 * a ^ 5 + 4164440 * a ^ 4 + 60806880 * + a ^ 3 * b ^ 2 - 9613240 * a ^ 3 - 186179032 * a ^ 2 * b ^ 2 + 10858680 * a ^ 2 + 61507440 + * a * b ^ 4 + 200597200 * a * b ^ 2 - 6032600 * a - 27911472 * b ^ 4 - 77954313 * b ^ 2 + + 1323280) * h1 + (-134223552 * a ^ 4 * b + 495960352 * a ^ 3 * b - 102559104 * a ^ 2 * b ^ + 3 - 614528088 * a ^ 2 * b + 178008352 * a * b ^ 3 + 282769768 * a * b + 31664448 * b ^ 5 - + 83358520 * b ^ 3 - 29482250 * b) * h2 + (-1821456 * a ^ 5 + 10391640 * a ^ 4 - 273210912 * + a ^ 3 * b ^ 2 - 22853824 * a ^ 3 + 780180072 * a ^ 2 * b ^ 2 + 24465112 * a ^ 2 - + 271389456 * a * b ^ 4 - 528230520 * a * b ^ 2 - 12828032 * a + 296316432 * b ^ 4 + + 31363599 * b ^ 2 + 2646560) * h3 + (199093536 * a ^ 4 * b - 498385232 * a ^ 3 * b + + 24939072 * a ^ 2 * b ^ 3 + 232444368 * a ^ 2 * b + 130606768 * a * b ^ 3 + 127289598 * a * + b - 174154464 * b ^ 5 + 27036544 * b ^ 3 - 66077130 * b) * h4 + (-3082464 * a ^ 5 + + 11707136 * a ^ 4 - 379412928 * a ^ 3 * b ^ 2 - 15964984 * a ^ 3 + 645359312 * a ^ 2 * b ^ + 2 + 8476776 * a ^ 2 - 376330464 * a * b ^ 4 - 236070536 * a * b ^ 2 - 474824 * a + + 142900176 * b ^ 4 - 12507798 * b ^ 2 - 661640) * h5 + (166658544 * a ^ 4 * b - 599132600 * + a ^ 3 * b + 63749088 * a ^ 2 * b ^ 3 + 703674108 * a ^ 2 * b - 263900600 * a * b ^ 3 - + 283956257 * a * b - 102909456 * b ^ 5 + 210095684 * b ^ 3 + 12756205 * b) * h6 + (560448 * + a ^ 5 - 3502800 * a ^ 4 + 167008896 * a ^ 3 * b ^ 2 + 8507912 * a ^ 3 - 416573760 * a ^ 2 + * b ^ 2 - 10072496 * a ^ 2 + 166448448 * a * b ^ 4 + 220295208 * a * b ^ 2 + 5830216 * a - + 233358960 * b ^ 4 + 22379388 * b ^ 2 - 1323280) * h7 + (-101788560 * a ^ 4 * b + 259747720 + * a ^ 3 * b - 141369120 * a ^ 2 * b ^ 3 - 133654452 * a ^ 2 * b + 235555720 * a * b ^ 3 - + 51577653 * a * b - 39580560 * b ^ 5 - 61674284 * b ^ 3 + 30061185 * b) * h8 + (1961568 * a + ^ 5 - 11302368 * a ^ 4 + 45395136 * a ^ 3 * b ^ 2 + 24916584 * a ^ 3 - 191749456 * a ^ 2 * + b ^ 2 - 26379976 * a ^ 2 + 43433568 * a * b ^ 4 + 186631544 * a * b ^ 2 + 13450752 * a - + 49119088 * b ^ 4 - 35839154 * b ^ 2 - 2646560) * h9 + linarith only [he] + +theorem normalized_3 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 3 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 4466070 * (b * z 3) = 0 := by + linear_combination (-41654016 * a ^ 4 + 182198868 * a ^ 3 - 78159744 * a ^ 2 * b ^ 2 - + 294510078 * a ^ 2 + 138594708 * a * b ^ 2 + 209039616 * a - 36505728 * b ^ 4 - 60434964 * + b ^ 2 - 55074390) * h0 + (-49443264 * a ^ 3 * b + 141836910 * a ^ 2 * b - 49443264 * a * b + ^ 3 - 135043059 * a * b + 31790286 * b ^ 3 + 42649413 * b) * h1 + (83308032 * a ^ 4 - + 294974376 * a ^ 3 + 72877824 * a ^ 2 * b ^ 2 + 354778736 * a ^ 2 - 118485288 * a * b ^ 2 - + 161470522 * a - 10430208 * b ^ 4 + 49347396 * b ^ 2 + 18358130) * h2 + (138033216 * a ^ 3 + * b - 378198114 * a ^ 2 * b + 138033216 * a * b ^ 3 + 254209029 * a * b - 135266562 * b ^ + 3 - 22853610 * b) * h3 + (-124962048 * a ^ 4 + 296672508 * a ^ 3 - 67595904 * a ^ 2 * b ^ + 2 - 137453826 * a ^ 2 - 12701508 * a * b ^ 2 - 65927224 * a + 57366144 * b ^ 4 + 8791788 * + b ^ 2 + 36716260) * h4 + (182328192 * a ^ 3 * b - 329874204 * a ^ 2 * b + 182328192 * a * + b ^ 3 + 143535678 * a * b - 92263644 * b ^ 3 + 4010334 * b) * h5 + (-104135040 * a ^ 4 + + 358304466 * a ^ 3 - 70236864 * a ^ 2 * b ^ 2 - 408337207 * a ^ 2 + 187136370 * a * b ^ 2 + + 163346846 * a + 33898176 * b ^ 4 - 113982858 * b ^ 2 - 9179065) * h6 + (-93738240 * a ^ 3 + * b + 211722024 * a ^ 2 * b - 93738240 * a * b ^ 3 - 99916236 * a * b + 106996392 * b ^ 3 + - 11119530 * b) * h7 + (62481024 * a ^ 4 - 148336254 * a ^ 3 + 75518784 * a ^ 2 * b ^ 2 + + 68726913 * a ^ 2 - 110053086 * a * b ^ 2 + 32963612 * a + 13037760 * b ^ 4 + 29358966 * b + ^ 2 - 18358130) * h8 + (5148288 * a ^ 3 * b + 29274828 * a ^ 2 * b + 5148288 * a * b ^ 3 - + 64044326 * a * b + 1115532 * b ^ 3 + 26064230 * b) * h9 + linarith only [he] + +theorem normalized_4 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 4 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 1488690 * (b * z 4) = 0 := by + linear_combination (37852512 * a ^ 4 - 172463856 * a ^ 3 + 88738368 * a ^ 2 * b ^ 2 + + 289936026 * a ^ 2 - 155470896 * a * b ^ 2 - 213890532 * a + 50885856 * b ^ 4 + 62762688 * + b ^ 2 + 58565850) * h0 + (38605248 * a ^ 3 * b - 120079440 * a ^ 2 * b + 38605248 * a * b + ^ 3 + 129183723 * a * b - 25628592 * b ^ 3 - 48453876 * b) * h1 + (-75705024 * a ^ 4 + + 281840192 * a ^ 3 - 61166208 * a ^ 2 * b ^ 2 - 355519812 * a ^ 2 + 109931456 * a * b ^ 2 + + 168906594 * a + 14538816 * b ^ 4 - 51789752 * b ^ 2 - 19521950) * h2 + (-141882432 * a ^ 3 + * b + 406776048 * a ^ 2 * b - 141882432 * a * b ^ 3 - 281084493 * a * b + 157409424 * b ^ + 3 + 17859180 * b) * h3 + (113557536 * a ^ 4 - 290276496 * a ^ 3 + 33594048 * a ^ 2 * b ^ 2 + + 150462542 * a ^ 2 + 36548016 * a * b ^ 2 + 64505888 * a - 79963488 * b ^ 4 + 8447504 * b + ^ 2 - 39043900) * h4 + (-193521024 * a ^ 3 * b + 344977488 * a ^ 2 * b - 193521024 * a * b + ^ 3 - 141372846 * a * b + 91238928 * b ^ 3 - 2640168 * b) * h5 + (94631280 * a ^ 4 - + 342837112 * a ^ 3 + 47380128 * a ^ 2 * b ^ 2 + 410746929 * a ^ 2 - 166556440 * a * b ^ 2 - + 172302072 * a - 47251152 * b ^ 4 + 125442796 * b ^ 2 + 9760975) * h6 + (90243840 * a ^ 3 * + b - 223054128 * a ^ 2 * b + 90243840 * a * b ^ 3 + 116671212 * a * b - 124231344 * b ^ 3 + + 15185760 * b) * h7 + (-56778768 * a ^ 4 + 145138248 * a ^ 3 - 74952288 * a ^ 2 * b ^ 2 - + 75231271 * a ^ 2 + 123773352 * a * b ^ 2 - 32252944 * a - 18173520 * b ^ 4 - 32066692 * b + ^ 2 + 19521950) * h8 + (13033344 * a ^ 3 * b - 70104176 * a ^ 2 * b + 13033344 * a * b ^ 3 + + 78021142 * a * b - 14011184 * b ^ 3 - 20155880 * b) * h9 + linarith only [he] + +theorem normalized_5 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 5 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 20841660 * (b * z 5) = 0 := by + linear_combination (1167326352 * a ^ 4 * b - 5486644488 * a ^ 3 * b + 3051196704 * a ^ 2 * b ^ + 3 + 9472188072 * a ^ 2 * b - 5367220488 * a * b ^ 3 - 7155733008 * a * b + 1883870352 * b + ^ 5 + 2202883344 * b ^ 3 + 2002863072 * b) * h0 + (-1050840 * a ^ 5 + 6246660 * a ^ 4 + + 1072714320 * a ^ 3 * b ^ 2 - 14419860 * a ^ 3 - 3597660468 * a ^ 2 * b ^ 2 + 16288020 * a + ^ 2 + 1073765160 * a * b ^ 4 + 4155921120 * a * b ^ 2 - 9048900 * a - 797443128 * b ^ 4 - + 1660748772 * b ^ 2 + 1984920) * h1 + (-2327927328 * a ^ 4 * b + 9003599088 * a ^ 3 * b - + 1789678656 * a ^ 2 * b ^ 3 - 11712971572 * a ^ 2 * b + 3510095088 * a * b ^ 3 + 5702568122 + * a * b + 538248672 * b ^ 5 - 1764410340 * b ^ 3 - 660802240 * b) * h2 + (-2732184 * a ^ 5 + + 15587460 * a ^ 4 - 4663000368 * a ^ 3 * b ^ 2 - 34280736 * a ^ 3 + 13771387308 * a ^ 2 * + b ^ 2 + 36697668 * a ^ 2 - 4660268184 * a * b ^ 4 - 9769958220 * a * b ^ 2 - 19242048 * a + + 5575255848 * b ^ 4 + 594610596 * b ^ 2 + 3969840) * h3 + (3488528304 * a ^ 4 * b - + 9415529688 * a ^ 3 * b + 528160608 * a ^ 2 * b ^ 3 + 5182313232 * a ^ 2 * b + 1452054312 * + a * b ^ 3 + 2110446812 * a * b - 2960367696 * b ^ 5 + 396671496 * b ^ 3 - 1337483840 * b) + * h4 + (-4623696 * a ^ 5 + 17560704 * a ^ 4 - 6458143392 * a ^ 3 * b ^ 2 - 23947476 * a ^ + 3 + 11571734808 * a ^ 2 * b ^ 2 + 12715164 * a ^ 2 - 6453519696 * a * b ^ 4 - 4764364764 * + a * b ^ 2 - 712236 * a + 3075070104 * b ^ 4 - 119968392 * b ^ 2 - 992460) * h5 + + (2908227816 * a ^ 4 * b - 10957448100 * a ^ 3 * b + 1158919632 * a ^ 2 * b ^ 3 + + 13556332142 * a ^ 2 * b - 5165384100 * a * b ^ 3 - 5839746013 * a * b - 1749308184 * b ^ 5 + + 4323671106 * b ^ 3 + 327423740 * b) * h6 + (840672 * a ^ 5 - 5254200 * a ^ 4 + + 2867857344 * a ^ 3 * b ^ 2 + 12761868 * a ^ 3 - 7507687200 * a ^ 2 * b ^ 2 - 15108744 * a + ^ 2 + 2867016672 * a * b ^ 4 + 4143938652 * a * b ^ 2 + 8745324 * a - 4397409000 * b ^ 4 + + 523971312 * b ^ 2 - 1984920) * h7 + (-1747626840 * a ^ 4 * b + 4723597500 * a ^ 3 * b - + 2420437680 * a ^ 2 * b ^ 3 - 2617305018 * a ^ 2 * b + 4305613500 * a * b ^ 3 - 1037122687 + * a * b - 672810840 * b ^ 5 - 1134444486 * b ^ 3 + 664275850 * b) * h8 + (2942352 * a ^ 5 + - 16953552 * a ^ 4 + 722428704 * a ^ 3 * b ^ 2 + 37374876 * a ^ 3 - 2905634904 * a ^ 2 * b + ^ 2 - 39569964 * a ^ 2 + 719486352 * a * b ^ 4 + 2825006596 * a * b ^ 2 + 20176128 * a - + 619625352 * b ^ 4 - 677080816 * b ^ 2 - 3969840) * h9 + linarith only [he] + +theorem normalized_6 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 6 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 4466070 * (b * z 6) = 0 := by + linear_combination (-28007136 * a ^ 4 + 116376648 * a ^ 3 - 42467904 * a ^ 2 * b ^ 2 - + 178359318 * a ^ 2 + 74172168 * a * b ^ 2 + 119617236 * a - 14460768 * b ^ 4 - 31704264 * b + ^ 2 - 29627430) * h0 + (-36846144 * a ^ 3 * b + 97078740 * a ^ 2 * b - 36846144 * a * b ^ + 3 - 82153569 * a * b + 19924596 * b ^ 3 + 21920973 * b) * h1 + (56014272 * a ^ 4 - + 186074736 * a ^ 3 + 51882624 * a ^ 2 * b ^ 2 + 209436116 * a ^ 2 - 73970928 * a * b ^ 2 - + 89251462 * a - 4131648 * b ^ 4 + 26406576 * b ^ 2 + 9875810) * h2 + (83445696 * a ^ 3 * b + - 212855244 * a ^ 2 * b + 83445696 * a * b ^ 3 + 132512199 * a * b - 65801772 * b ^ 3 - + 14235885 * b) * h3 + (-84021408 * a ^ 4 + 181087128 * a ^ 3 - 61297344 * a ^ 2 * b ^ 2 - + 70210866 * a ^ 2 - 916008 * a * b ^ 2 - 40241584 * a + 22724064 * b ^ 4 + 10563528 * b ^ 2 + + 19751620) * h4 + (106745472 * a ^ 3 * b - 189444504 * a ^ 2 * b + 106745472 * a * b ^ 3 + + 80855178 * a * b - 51211224 * b ^ 3 + 1843854 * b) * h5 + (-70017840 * a ^ 4 + 225591636 + * a ^ 3 - 56589984 * a ^ 2 * b ^ 2 - 239702767 * a ^ 2 + 122308020 * a * b ^ 2 + 89066876 + * a + 13427856 * b ^ 4 - 58889088 * b ^ 2 - 4937905) * h6 + (-60145920 * a ^ 3 * b + + 120493344 * a ^ 2 * b - 60145920 * a * b ^ 3 - 47956356 * a * b + 52159392 * b ^ 3 - + 4753200 * b) * h7 + (42010704 * a ^ 4 - 90543564 * a ^ 3 + 47175264 * a ^ 2 * b ^ 2 + + 35105433 * a ^ 2 - 57159276 * a * b ^ 2 + 20120792 * a + 5164560 * b ^ 4 + 14868336 * b ^ + 2 - 9875810) * h8 + (13546368 * a ^ 3 * b - 2880552 * a ^ 2 * b + 13546368 * a * b ^ 3 - + 31333826 * a * b - 4445928 * b ^ 3 + 15791810 * b) * h9 + linarith only [he] + +theorem normalized_7 (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) : b * z 7 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 20841660 * (b * z 7) = 0 := by + linear_combination (566065296 * a ^ 4 * b - 3474665256 * a ^ 3 * b + 1710434592 * a ^ 2 * b ^ + 3 + 7173706128 * a ^ 2 * b - 3378281256 * a * b ^ 3 - 6187677672 * a * b + 1144369296 * b + ^ 5 + 1667846664 * b ^ 3 + 1922571504 * b) * h0 + (133456680 * a ^ 5 - 668275860 * a ^ 4 + + 1134369360 * a ^ 3 * b ^ 2 + 1213019640 * a ^ 3 - 4276249620 * a ^ 2 * b ^ 2 - 970917780 * + a ^ 2 + 1000912680 * a * b ^ 4 + 5143100916 * a * b ^ 2 + 308596680 * a - 1342949760 * b ^ + 4 - 2001220656 * b ^ 2 - 15879360) * h1 + (-1986253344 * a ^ 4 * b + 8272106544 * a ^ 3 * + b - 1659290688 * a ^ 2 * b ^ 3 - 11559403732 * a ^ 2 * b + 3838442544 * a * b ^ 3 + + 6106744502 * a * b + 326962656 * b ^ 5 - 2040556644 * b ^ 3 - 833193970 * b) * h2 + + (346987368 * a ^ 5 - 1654477524 * a ^ 4 - 3065001264 * a ^ 3 * b ^ 2 + 2823875628 * a ^ 3 + + 9765448140 * a ^ 2 * b ^ 2 - 2110974096 * a ^ 2 - 3411988632 * a * b ^ 4 - 7448473272 * + a * b ^ 2 + 626347344 * a + 4817621664 * b ^ 4 + 334854252 * b ^ 2 - 31758720) * h3 + + (3406441392 * a ^ 4 * b - 10563563832 * a ^ 3 * b + 1608146784 * a ^ 2 * b ^ 3 + + 7525107432 * a ^ 2 * b - 1792619832 * a * b ^ 3 + 1445268380 * a * b - 1798294608 * b ^ 5 + + 322488720 * b ^ 3 - 1581036380 * b) * h4 + (587209392 * a ^ 5 - 1679989584 * a ^ 4 - + 4030317216 * a ^ 3 * b ^ 2 + 1501825500 * a ^ 3 + 8748321240 * a ^ 2 * b ^ 2 - 304580136 * + a ^ 2 - 4617526608 * a * b ^ 4 - 4967458044 * a * b ^ 2 - 112404852 * a + 3585046824 * b ^ + 4 + 249454020 * b ^ 2 + 7939680) * h5 + (2696347368 * a ^ 4 * b - 10661371764 * a ^ 3 * b + + 1633718736 * a ^ 2 * b ^ 3 + 13942807346 * a ^ 2 * b - 5986747764 * a * b ^ 3 - + 6418198975 * a * b - 1062628632 * b ^ 5 + 4773265614 * b ^ 3 + 440416025 * b) * h6 + + (-106765344 * a ^ 5 + 567243432 * a ^ 4 + 2099685312 * a ^ 3 * b ^ 2 - 1095547404 * a ^ 3 + - 5754692256 * a ^ 2 * b ^ 2 + 925358028 * a ^ 2 + 2206450656 * a * b ^ 4 + 3031404516 * a + * b ^ 2 - 306168072 * a - 3815951688 * b ^ 4 + 846400164 * b ^ 2 + 15879360) * h7 + + (-1276159320 * a ^ 4 * b + 3671194476 * a ^ 3 * b - 1684862640 * a ^ 2 * b ^ 3 - + 1925632854 * a ^ 2 * b + 3333850476 * a * b ^ 3 - 1393691857 * a * b - 408703320 * b ^ 5 - + 861382746 * b ^ 3 + 831457165 * b) * h8 + (-373678704 * a ^ 5 + 1802961216 * a ^ 4 - + 169053408 * a ^ 3 * b ^ 2 - 3079276452 * a ^ 3 + 167628264 * a ^ 2 * b ^ 2 + 2245107984 * + a ^ 2 + 204625296 * a * b ^ 4 + 228391252 * a * b ^ 2 - 633819984 * a + 195963048 * b ^ 4 + - 428148292 * b ^ 2 + 31758720) * h9 + linarith only [he] + +theorem even_0 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 1 * z 0 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 3 * (a * c ^ 1 * z 0) = 0 := by + linear_combination (c) * h0 + linarith only [he] + +theorem even_1 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 3 * z 1 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 867 * (a * c ^ 3 * z 1) = 0 := by + linear_combination (-10 * a * c ^ 2 + 170 * c ^ 3) * h1 + (10 * a ^ 2 * c - 118 * a * c ^ 2 + + 340 * c ^ 3) * h3 + (-10 * a * c ^ 2 - 85 * c ^ 3) * h5 + (10 * a ^ 2 * c - 16 * a * c ^ 2 + - 170 * c ^ 3) * h7 + (-10 * a ^ 3 + 24 * a ^ 2 * c + 198 * a * c ^ 2 - 340 * c ^ 3) * h9 + linarith only [he] + +theorem even_2 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 1 * z 2 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 18 * (a * c ^ 1 * z 2) = 0 := by + linear_combination (4 * c) * h2 + (2 * a + 8 * c) * h4 + (-2 * c) * h6 + (-a - 4 * c) * h8 + linarith only [he] + +theorem even_3 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 3 * z 3 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 10404 * (a * c ^ 3 * z 3) = 0 := by + linear_combination (5 * a * c ^ 2 - 374 * c ^ 3) * h1 + (-5 * a ^ 2 * c + 348 * a * c ^ 2 - + 748 * c ^ 3) * h3 + (5 * a * c ^ 2 + 187 * c ^ 3) * h5 + (-5 * a ^ 2 * c + 297 * a * c ^ 2 + + 374 * c ^ 3) * h7 + (5 * a ^ 3 - 301 * a ^ 2 * c + 1924 * a * c ^ 2 + 748 * c ^ 3) * h9 + linarith only [he] + +theorem even_4 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 3 * z 4 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 6936 * (a * c ^ 3 * z 4) = 0 := by + linear_combination (-355 * a * c ^ 2 + 1122 * c ^ 3) * h1 + (355 * a ^ 2 * c - 2744 * a * c ^ + 2 + 2244 * c ^ 3) * h3 + (-355 * a * c ^ 2 - 561 * c ^ 3) * h5 + (355 * a ^ 2 * c + 877 * + a * c ^ 2 - 1122 * c ^ 3) * h7 + (-355 * a ^ 3 - 593 * a ^ 2 * c + 3272 * a * c ^ 2 - 2244 + * c ^ 3) * h9 + linarith only [he] + +theorem even_5 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 1 * z 5 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 36 * (a * c ^ 1 * z 5) = 0 := by + linear_combination (2 * c) * h2 + (-8 * a + 4 * c) * h4 + (-c) * h6 + (4 * a - 2 * c) * h8 + linarith only [he] + +theorem even_6 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 3 * z 6 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 20808 * (a * c ^ 3 * z 6) = 0 := by + linear_combination (25 * a * c ^ 2 - 1870 * c ^ 3) * h1 + (-25 * a ^ 2 * c + 1740 * a * c ^ 2 + - 3740 * c ^ 3) * h3 + (25 * a * c ^ 2 + 935 * c ^ 3) * h5 + (-25 * a ^ 2 * c + 1485 * a * + c ^ 2 + 1870 * c ^ 3) * h7 + (25 * a ^ 3 - 1505 * a ^ 2 * c - 784 * a * c ^ 2 + 3740 * c ^ + 3) * h9 + linarith only [he] + +theorem even_7 (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) : a * c ^ 1 * z 7 = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + have he : 36 * (a * c ^ 1 * z 7) = 0 := by + linear_combination (-16 * c) * h2 + (-8 * a - 32 * c) * h4 + (8 * c) * h6 + (13 * a + 16 * c) + * h8 + linarith only [he] + + +/-- Every nonzero tracefree cubic has injective obstruction matrix. -/ +theorem tracefree_injective (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (-a) (-b) z) (hab : a ≠ 0 ∨ b ≠ 0) : z = 0 := by + have hn : a ^ 2 + b ^ 2 ≠ 0 := by + rcases hab with ha | hb + · exact ne_of_gt (add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero ha) (sq_nonneg b)) + · exact ne_of_gt (add_pos_of_nonneg_of_pos (sq_nonneg a) (sq_pos_of_ne_zero hb)) + funext i + change z i = 0 + have hm : (a ^ 2 + b ^ 2) ^ 2 * z i = 0 := by + fin_cases i + · exact tracefree_0 a b z h + · exact tracefree_1 a b z h + · exact tracefree_2 a b z h + · exact tracefree_3 a b z h + · exact tracefree_4 a b z h + · exact tracefree_5 a b z h + · exact tracefree_6 a b z h + · exact tracefree_7 a b z h + exact (mul_eq_zero.mp hm).resolve_left (pow_ne_zero 2 hn) + +/-- The even slice has injective obstruction matrix away from its two axes. -/ +theorem even_injective (a c : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a 0 c 0 z) (ha : a ≠ 0) (hc : c ≠ 0) : z = 0 := by + funext i + change z i = 0 + fin_cases i + · exact (mul_eq_zero.mp (even_0 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 1 hc)) + · exact (mul_eq_zero.mp (even_1 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 3 hc)) + · exact (mul_eq_zero.mp (even_2 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 1 hc)) + · exact (mul_eq_zero.mp (even_3 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 3 hc)) + · exact (mul_eq_zero.mp (even_4 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 3 hc)) + · exact (mul_eq_zero.mp (even_5 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 1 hc)) + · exact (mul_eq_zero.mp (even_6 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 3 hc)) + · exact (mul_eq_zero.mp (even_7 a c z h)).resolve_left (mul_ne_zero ha (pow_ne_zero 1 hc)) + +/-- The trace-normalized slice has exactly the two possible rank exceptions. -/ +theorem normalized_classification (a b : ℝ) (z : Fin 8 → ℝ) + (h : Kernel a b (1 - a) (-b) z) (hz : z ≠ 0) : b = 0 ∧ (a = 0 ∨ a = 1) := by + have hb : b = 0 := by + by_contra hb + apply hz + funext i + change z i = 0 + have hm : b * z i = 0 := by + fin_cases i + · exact normalized_0 a b z h + · exact normalized_1 a b z h + · exact normalized_2 a b z h + · exact normalized_3 a b z h + · exact normalized_4 a b z h + · exact normalized_5 a b z h + · exact normalized_6 a b z h + · exact normalized_7 a b z h + exact (mul_eq_zero.mp hm).resolve_left hb + refine ⟨hb, ?_⟩ + by_cases ha : a = 0 + · exact Or.inl ha + · right + by_contra hane + have hc : 1 - a ≠ 0 := by intro he; apply hane; linarith + have hk : Kernel a 0 (1 - a) 0 z := by simpa only [hb, neg_zero] using h + exact hz (even_injective a (1 - a) z hk ha hc) + +/-- At the pure-cube representative, the kernel has only its final coordinate. -/ +theorem pure_kernel (z : Fin 8 → ℝ) (h : Kernel 1 0 0 0 z) : + ∀ i : Fin 8, i ≠ 7 → z i = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + intro i hi + fin_cases i <;> norm_num at * <;> linarith + +/-- At the mixed representative, every kernel vector has the stated ratios. -/ +theorem mixed_kernel (z : Fin 8 → ℝ) (h : Kernel 0 0 1 0 z) : + z 1 = 0 ∧ z 3 = 0 ∧ z 4 = 0 ∧ z 6 = 0 ∧ + z 0 = 2 * z 5 ∧ z 2 = 4 * z 5 ∧ z 7 = -8 * z 5 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + norm_num at * + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ <;> linarith + +/-- Tangency to the pure-cube graph removes its remaining kernel direction. -/ +theorem pure_tangent_injective (z : Fin 8 → ℝ) (h : Kernel 1 0 0 0 z) + (ht : z 7 = 0) : z = 0 := by + funext i + change z i = 0 + by_cases hi : i = 7 + · simpa only [hi] using ht + · exact pure_kernel z h i hi + +/-- Tangency to the mixed-cube graph removes its remaining kernel direction. -/ +theorem mixed_tangent_injective (z : Fin 8 → ℝ) (h : Kernel 0 0 1 0 z) + (ht : z 0 = 0) : z = 0 := by + rcases mixed_kernel z h with ⟨h1, h3, h4, h6, h0, h2, h7⟩ + funext i + change z i = 0 + fin_cases i <;> norm_num at * <;> linarith +end PlanarMidpoint.Algebra diff --git a/LeanPool/PlanarMidpoint/AnalyticObstruction.lean b/LeanPool/PlanarMidpoint/AnalyticObstruction.lean new file mode 100644 index 0000000000..cb5026316d --- /dev/null +++ b/LeanPool/PlanarMidpoint/AnalyticObstruction.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.ApproximationRemainder +public import LeanPool.PlanarMidpoint.LocalBounds +public import LeanPool.PlanarMidpoint.Negation +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Ring + +/-! +# Complementary geodesic midpoints force the fourth-order obstruction + +The proof compares actual short geodesics with explicit polynomial trajectories. +It needs no differentiability of a family of solutions with respect to endpoints. +-/ + +@[expose] public section + +noncomputable section +namespace PlanarMidpoint +open Set Metric + +/-- Complementarity for arbitrarily short actual geodesics annihilates the +first-order quartic obstruction. -/ +theorem obstruction_of_short_complementary_pairs {Ω : Set E} {C : E → Coeff} {p : E} + (hΩ : IsOpen Ω) (hp : p ∈ Ω) (hC : ContDiffOn ℝ 2 C Ω) + (hpairs : ArbitrarilyShortComplementaryPairs C p) (h : E) : + obstruction (C p) (fderiv ℝ C p) h = 0 := by + let c := C p + let J := fderiv ℝ C p + let H : Hessian := fderiv ℝ (fderiv ℝ C) p + let e := obstruction c J h + change e = 0 + by_contra he + have hne : 0 < ‖e‖ := norm_pos_iff.mpr he + let κ := ‖e‖ / 1000 + have hκ : 0 < κ := by dsimp [κ]; positivity + obtain ⟨r, hr, M, hM, L, hL, _hsub, hbound, hLip, hsmall⟩ := local_coefficient_bounds hΩ hp hC + have hTaylor : ∀ η > (0 : ℝ), ∃ ρ > (0 : ℝ), ∀ d : E, ‖d‖ < ρ → + ‖C (p + d) - c - J d - (1 / 2 : ℝ) • H d d‖ ≤ η * ‖d‖ ^ 2 := by + intro η hη + obtain ⟨ρ, hρ, _hsub, herr⟩ := exists_second_order_spatial_remainder hΩ hp hC hη + exact ⟨ρ, hρ, herr⟩ + have hTaylorMinus : ∀ η > (0 : ℝ), ∃ ρ > (0 : ℝ), ∀ d : E, ‖d‖ < ρ → + ‖(-C) (p + d) - (-c) - (-J) d - (1 / 2 : ℝ) • (-H) d d‖ ≤ η * ‖d‖ ^ 2 := by + intro η hη + obtain ⟨ρ, hρ, herr⟩ := hTaylor η hη + refine ⟨ρ, hρ, ?_⟩ + intro d hd + rw [neg_coeff_taylor_remainder] + exact herr d hd + obtain ⟨δPlus, hδPlus, hPlus⟩ := exists_short_geodesic_approximation + C p c J H h r M L hr hM hL hbound hLip hsmall hTaylor κ hκ + obtain ⟨δMinus, hδMinus, hMinus⟩ := exists_short_geodesic_approximation + (-C) p (-c) (-J) (-H) h r M L hr hM hL + (fun x hx ↦ by simpa only [Pi.neg_apply, norm_neg] using hbound x hx) + (fun x hx y hy ↦ by simpa only [norm_neg_coeff_sub] using hLip x hx y hy) + hsmall hTaylorMinus κ hκ + obtain ⟨δPair, hδPair, hPair⟩ := hpairs r hr + obtain ⟨ε, hε, hεδ⟩ := exists_between + (show 0 < min δPlus (min δMinus (δPair / (‖h‖ + 1))) by positivity) + have hεPlus : ε < δPlus := lt_of_lt_of_le hεδ (min_le_left _ _) + have hεMinus : ε < δMinus := lt_of_lt_of_le hεδ + ((min_le_right _ _).trans (min_le_left _ _)) + have hεEnd : ε < δPair / (‖h‖ + 1) := lt_of_lt_of_le hεδ + ((min_le_right _ _).trans (min_le_right _ _)) + have hscalar : (ε / 2) * ‖h‖ < δPair := by + have hh := (lt_div_iff₀ (show 0 < ‖h‖ + 1 by positivity)).mp hεEnd + nlinarith [norm_nonneg h] + have hP : p - (ε / 2) • h ∈ ball p δPair := by + rw [mem_ball, dist_eq_norm] + have hh : p - (ε / 2) • h - p = -((ε / 2) • h) := by module + rw [hh, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_nonneg (by positivity)] + exact hscalar + have hQ : p + (ε / 2) • h ∈ ball p δPair := by + rw [mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul, + Real.norm_eq_abs, abs_of_nonneg (by positivity)] + exact hscalar + obtain ⟨γPlus, vPlus, γMinus, vMinus, hγPlus, hγMinus, hcomp⟩ := hPair _ _ hP hQ + have herrPlus := hPlus ε hε.le hεPlus γPlus vPlus hγPlus + have herrMinus := hMinus ε hε.le hεMinus γMinus vMinus + ((isShortGeodesic_neg C p r _ _ γMinus vMinus).mp hγMinus) + let dPlus := approxDisplacement c J H h ε (1 / 2) + let dMinus := approxDisplacement (-c) (-J) (-H) h ε (1 / 2) + have hdefect : ‖dPlus + dMinus‖ ≤ 2 * κ * ε ^ 4 := by + calc + ‖dPlus + dMinus‖ = ‖(p + dPlus - γPlus (1 / 2)) + (p + dMinus - γMinus (1 / 2))‖ := by + congr 1 + have hsum : p + p = γPlus (1 / 2) + γMinus (1 / 2) := by + calc + p + p = (p - (ε / 2) • h) + (p + (ε / 2) • h) := by module + _ = _ := hcomp.symm + calc + dPlus + dMinus = (p + dPlus) + (p + dMinus) - (p + p) := by module + _ = _ := by rw [hsum]; module + _ ≤ ‖p + dPlus - γPlus (1 / 2)‖ + ‖p + dMinus - γMinus (1 / 2)‖ := norm_add_le _ _ + _ ≤ κ * ε ^ 4 + κ * ε ^ 4 := add_le_add + (by simpa only [norm_sub_rev] using herrPlus) + (by simpa only [norm_sub_rev] using herrMinus) + _ = _ := by ring + have hpoly : dPlus + dMinus = (ε ^ 4 / 192) • e := + approxDisplacement_add_opposite_midpoint c J H h ε + rw [hpoly, norm_smul, Real.norm_eq_abs, abs_of_nonneg (by positivity)] at hdefect + have hε4 : 0 < ε ^ 4 := pow_pos hε 4 + have hnorm : ‖e‖ / 192 ≤ 2 * κ := by + apply le_of_mul_le_mul_right (a := ε ^ 4) _ hε4 + nlinarith + dsimp [κ] at hnorm + linarith + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/ApproximationRemainder.lean b/LeanPool/PlanarMidpoint/ApproximationRemainder.lean new file mode 100644 index 0000000000..ec29ba2886 --- /dev/null +++ b/LeanPool/PlanarMidpoint/ApproximationRemainder.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.JetAlgebra +public import LeanPool.PlanarMidpoint.SpatialTaylor +public import LeanPool.PlanarMidpoint.GeodesicEstimate +public import LeanPool.PlanarMidpoint.GeodesicDefinitions +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Ring + +/-! Uniform residual bounds for the actual coefficient field. -/ + +@[expose] public section +noncomputable section +namespace PlanarMidpoint +open Set + +theorem approx_actual_residual_bound (C : E → Coeff) (p : E) + (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) (h : E) + (η B T ε t : ℝ) (hη : 0 ≤ η) (hB : 0 ≤ B) (hε : 0 ≤ ε) + (hd : ‖approxDisplacement c J H h ε t‖ ≤ B * ε) + (hv : ‖approxVelocity c J H h ε t‖ ≤ B * ε) + (htail : ‖approxResidualTail c J H h ε t‖ ≤ T) + (hcoeff : let d := approxDisplacement c J H h ε t + ‖C (p + d) - c - J d - (1 / 2 : ℝ) • H d d‖ ≤ η * ‖d‖ ^ 2) : + ‖approxAcceleration c J H h ε t + K (C (p + approxDisplacement c J H h ε t)) + (approxVelocity c J H h ε t) (approxVelocity c J H h ε t)‖ ≤ + (8 * η * B ^ 4 + T * ε) * ε ^ 4 := by + let d := approxDisplacement c J H h ε t + let v := approxVelocity c J H h ε t + let a := approxAcceleration c J H h ε t + let cTaylor := c + J d + (1 / 2 : ℝ) • H d d + have hcoeff' : ‖C (p + d) - cTaylor‖ ≤ η * ‖d‖ ^ 2 := by + convert hcoeff using 1; congr 1; dsimp [cTaylor]; module + have hforce := force_taylor_error_bound (C (p + d)) cTaylor d v η B ε + hη hB hε hcoeff' hd hv + have hpoly : a + K cTaylor v v = ε ^ 5 • approxResidualTail c J H h ε t := + approx_residual_exact c J H h ε t + change ‖a + K (C (p + d)) v v‖ ≤ _ + calc + ‖a + K (C (p + d)) v v‖ = ‖(a + K cTaylor v v) + (K (C (p + d)) v v - K cTaylor v v)‖ := by + congr 1; module + _ ≤ ‖a + K cTaylor v v‖ + ‖K (C (p + d)) v v - K cTaylor v v‖ := norm_add_le _ _ + _ ≤ T * ε ^ 5 + 8 * η * B ^ 4 * ε ^ 4 := by + apply add_le_add _ hforce + rw [hpoly, norm_smul, Real.norm_eq_abs, abs_of_nonneg (pow_nonneg hε 5)] + simpa only [mul_comm] using mul_le_mul_of_nonneg_left htail (pow_nonneg hε 5) + _ = _ := by ring + +/-- A short actual geodesic has the quartic midpoint polynomial as a uniform +approximation. All hypotheses on the approximate trajectory are explicit +polynomial bounds, while the actual curve is constrained only by the ODE. -/ +theorem short_geodesic_approximation + (C : E → Coeff) (p : E) (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) (h : E) + (r M L η B T ε ρ : ℝ) + (hM : 0 ≤ M) (hL : 0 ≤ L) (hr : 0 < r) (hη : 0 ≤ η) (hB : 0 ≤ B) + (hT : 0 ≤ T) (hε : 0 ≤ ε) + (hbound : ∀ x ∈ Metric.ball p r, ‖C x‖ ≤ M) + (hLip : ∀ x ∈ Metric.ball p r, ∀ y ∈ Metric.ball p r, + ‖C x - C y‖ ≤ L * ‖x - y‖) + (hsmall : 8 * L * r ^ 2 + 16 * M * r < 1 / 2) + (hcoeff : ∀ d : E, ‖d‖ < ρ → + ‖C (p + d) - c - J d - (1 / 2 : ℝ) • H d d‖ ≤ η * ‖d‖ ^ 2) + (hsize : ∀ t ∈ Icc (0 : ℝ) 1, + ‖approxDisplacement c J H h ε t‖ ≤ B * ε ∧ + ‖approxVelocity c J H h ε t‖ ≤ B * ε ∧ + ‖approxResidualTail c J H h ε t‖ ≤ T) + (hεr : B * ε < r) (hερ : B * ε < ρ) + (γ v : ℝ → E) + (hγ : IsShortGeodesic C 1 p r (p - (ε / 2) • h) (p + (ε / 2) • h) γ v) : + ‖γ (1 / 2) - (p + approxDisplacement c J H h ε (1 / 2))‖ ≤ + 2 * (8 * η * B ^ 4 + T * ε) * ε ^ 4 := by + let y : ℝ → E := fun t ↦ p + approxDisplacement c J H h ε t + let w := approxVelocity c J H h ε + let b := approxAcceleration c J H h ε + have hy (t : ℝ) (_ht : t ∈ Icc (0 : ℝ) 1) : HasDerivAt y (w t) t := by + simpa only [y, w, zero_add] using + (hasDerivAt_const t p).fun_add (hasDerivAt_approxDisplacement c J H h ε t) + have hw (t : ℝ) (_ht : t ∈ Icc (0 : ℝ) 1) : HasDerivAt w (b t) t := + hasDerivAt_approxVelocity c J H h ε t + have hyS (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : y t ∈ Metric.ball p r := by + change ‖p + approxDisplacement c J H h ε t - p‖ < r + simpa only [add_sub_cancel_left] using ((hsize t ht).1.trans_lt hεr) + have hres (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖b t + K (C (y t)) (w t) (w t)‖ ≤ (8 * η * B ^ 4 + T * ε) * ε ^ 4 := + approx_actual_residual_bound C p c J H h η B T ε t hη hB hε + (hsize t ht).1 (hsize t ht).2.1 (hsize t ht).2.2 + (hcoeff _ ((hsize t ht).1.trans_lt hερ)) + have hcmp := geodesic_polynomial_comparison C (Metric.ball p r) M L r + ((8 * η * B ^ 4 + T * ε) * ε ^ 4) hM hL hr.le hbound hLip (by linarith) + γ v y w b hγ.1.1 (by simpa using hγ.1.2) hy hw + (by simpa [y, approxDisplacement_zero, sub_eq_add_neg, neg_div, neg_smul] using hγ.2.1) + (by simpa [y, approxDisplacement_one] using hγ.2.2.1) + (fun t ht ↦ hγ.2.2.2 t ht |>.1) hyS + (fun t ht ↦ (hγ.2.2.2 t ht).2.le) + (fun t ht ↦ (hsize t ht).2.1.trans hεr.le) hres (1 / 2) (by norm_num) + have hden : 0 < 1 - 8 * L * r ^ 2 - 16 * M * r := by linarith + have hR : 0 ≤ (8 * η * B ^ 4 + T * ε) * ε ^ 4 := by positivity + refine hcmp.1.trans ?_ + apply (div_le_iff₀ hden).mpr + nlinarith + +/-- Uniform fourth-order approximation, expressed without any differentiability +of the endpoint-to-geodesic choice. -/ +theorem exists_short_geodesic_approximation + (C : E → Coeff) (p : E) (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) (h : E) + (r M L : ℝ) (hr : 0 < r) (hM : 0 ≤ M) (hL : 0 ≤ L) + (hbound : ∀ x ∈ Metric.ball p r, ‖C x‖ ≤ M) + (hLip : ∀ x ∈ Metric.ball p r, ∀ y ∈ Metric.ball p r, + ‖C x - C y‖ ≤ L * ‖x - y‖) + (hsmall : 8 * L * r ^ 2 + 16 * M * r < 1 / 2) + (hTaylor : ∀ η > (0 : ℝ), ∃ ρ > (0 : ℝ), ∀ d : E, ‖d‖ < ρ → + ‖C (p + d) - c - J d - (1 / 2 : ℝ) • H d d‖ ≤ η * ‖d‖ ^ 2) + (κ : ℝ) (hκ : 0 < κ) : + ∃ δ > (0 : ℝ), ∀ ε : ℝ, 0 ≤ ε → ε < δ → ∀ γ v : ℝ → E, + IsShortGeodesic C 1 p r (p - (ε / 2) • h) (p + (ε / 2) • h) γ v → + ‖γ (1 / 2) - (p + approxDisplacement c J H h ε (1 / 2))‖ ≤ κ * ε ^ 4 := by + obtain ⟨B, hB, T, hT, hsize⟩ := approx_uniform_bounds c J H h + have hBpos : 0 < B := lt_of_lt_of_le zero_lt_one hB + let η := κ / (32 * B ^ 4) + have hη : 0 < η := by dsimp [η]; positivity + obtain ⟨ρ, hρ, hcoeff⟩ := hTaylor η hη + let δ := min 1 (min (r / B) (min (ρ / B) (κ / (4 * (T + 1))))) + have hδ : 0 < δ := by dsimp [δ]; positivity + refine ⟨δ, hδ, ?_⟩ + intro ε hε hεδ γ v hγ + have hε1 : ε < 1 := lt_of_lt_of_le hεδ (min_le_left _ _) + have hεr : ε < r / B := lt_of_lt_of_le hεδ + ((min_le_left _ _).trans' (min_le_right _ _)) + have hερ : ε < ρ / B := lt_of_lt_of_le hεδ + ((min_le_left _ _).trans' ((min_le_right _ _).trans' (min_le_right _ _))) + have hεT : ε < κ / (4 * (T + 1)) := lt_of_lt_of_le hεδ + ((min_le_right _ _).trans' ((min_le_right _ _).trans' (min_le_right _ _))) + have hBr : B * ε < r := by nlinarith [(lt_div_iff₀ hBpos).mp hεr] + have hBρ : B * ε < ρ := by nlinarith [(lt_div_iff₀ hBpos).mp hερ] + have hεabs : |ε| ≤ 1 := by simpa only [abs_of_nonneg hε] using hε1.le + have hsizeε : ∀ t ∈ Icc (0 : ℝ) 1, + ‖approxDisplacement c J H h ε t‖ ≤ B * ε ∧ + ‖approxVelocity c J H h ε t‖ ≤ B * ε ∧ + ‖approxResidualTail c J H h ε t‖ ≤ T := by + intro t ht + simpa only [abs_of_nonneg hε] using (hsize ε t hεabs ht) + have happrox := short_geodesic_approximation C p c J H h r M L η B T ε ρ + hM hL hr hη.le hBpos.le hT hε hbound hLip hsmall hcoeff + hsizeε + hBr hBρ γ v hγ + have hηeq : 16 * η * B ^ 4 = κ / 2 := by + dsimp [η] + field_simp [ne_of_gt hBpos] + ring + have hTε : 4 * T * ε ≤ κ := by + have := (lt_div_iff₀ (show 0 < 4 * (T + 1) by positivity)).mp hεT + nlinarith + refine happrox.trans ?_ + have hc : 2 * (8 * η * B ^ 4 + T * ε) ≤ κ := by nlinarith + exact mul_le_mul_of_nonneg_right hc (pow_nonneg hε 4) + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/BVPStability.lean b/LeanPool/PlanarMidpoint/BVPStability.lean new file mode 100644 index 0000000000..5592eabf4c --- /dev/null +++ b/LeanPool/PlanarMidpoint/BVPStability.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.GreenOperator +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum + +/-! Dirichlet stability with a quantitatively absorbable differential residual. -/ + +@[expose] public section +namespace PlanarMidpoint + +open Set + +variable {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] [CompleteSpace V] + +/-- A residual bound controls a zero-endpoint curve and its velocity whenever the +sum of the two Lipschitz constants is less than one. Compactness supplies the +maximum, so no a priori bound on the unknown error is assumed. -/ +theorem dirichlet_stability (x v a : ℝ → V) (R Lx Lv : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (hx0 : x 0 = 0) (hx1 : x 1 = 0) + (hLx : 0 ≤ Lx) (hLv : 0 ≤ Lv) (hsmall : Lx + Lv < 1) + (hres : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t‖ ≤ R + Lx * ‖x t‖ + Lv * ‖v t‖) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖x t‖ ≤ R / (1 - Lx - Lv) ∧ ‖v t‖ ≤ R / (1 - Lx - Lv) := by + have hxc : ContinuousOn x (Icc (0 : ℝ) 1) := + fun s hs ↦ (hx s hs).continuousAt.continuousWithinAt + have hvc : ContinuousOn v (Icc (0 : ℝ) 1) := + fun s hs ↦ (hv s hs).continuousAt.continuousWithinAt + obtain ⟨s, hs, hmax⟩ := isCompact_Icc.exists_isMaxOn + (show (Icc (0 : ℝ) 1).Nonempty from ⟨0, by norm_num⟩) (hxc.norm.sup hvc.norm) + let M := max ‖x s‖ ‖v s‖ + have hxM : ∀ u ∈ Icc (0 : ℝ) 1, ‖x u‖ ≤ M := + fun u hu ↦ (le_max_left _ _).trans (hmax hu) + have hvM : ∀ u ∈ Icc (0 : ℝ) 1, ‖v u‖ ≤ M := + fun u hu ↦ (le_max_right _ _).trans (hmax hu) + have haM : ∀ u ∈ Icc (0 : ℝ) 1, ‖a u‖ ≤ R + Lx * M + Lv * M := by + intro u hu + have h1 := mul_le_mul_of_nonneg_left (hxM u hu) hLx + have h2 := mul_le_mul_of_nonneg_left (hvM u hu) hLv + linarith [hres u hu] + have hMx : ‖x s‖ ≤ R + Lx * M + Lv * M := + dirichlet_position_bound x v a _ hx hv haM hx0 hx1 s hs + have hMv : ‖v s‖ ≤ R + Lx * M + Lv * M := + dirichlet_velocity_bound x v a _ hx hv haM hx0 hx1 s hs + have hMM : M ≤ R + Lx * M + Lv * M := max_le hMx hMv + have hd : 0 < 1 - Lx - Lv := by linarith + have hfinal : M ≤ R / (1 - Lx - Lv) := by + apply (le_div_iff₀ hd).mpr + nlinarith + exact ⟨(hxM t ht).trans hfinal, (hvM t ht).trans hfinal⟩ + +/-- Stability for a true and an approximate curve having the same endpoints. -/ +theorem bvp_stability (x v a y w b : ℝ → V) (R Lx Lv : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (hy : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt y (w t) t) + (hw : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt w (b t) t) + (h0 : x 0 = y 0) (h1 : x 1 = y 1) + (hLx : 0 ≤ Lx) (hLv : 0 ≤ Lv) (hsmall : Lx + Lv < 1) + (hres : ∀ t ∈ Icc (0 : ℝ) 1, + ‖a t - b t‖ ≤ R + Lx * ‖x t - y t‖ + Lv * ‖v t - w t‖) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖x t - y t‖ ≤ R / (1 - Lx - Lv) ∧ ‖v t - w t‖ ≤ R / (1 - Lx - Lv) := by + exact dirichlet_stability (fun s ↦ x s - y s) (fun s ↦ v s - w s) + (fun s ↦ a s - b s) R Lx Lv + (fun s hs ↦ (hx s hs).fun_sub (hy s hs)) + (fun s hs ↦ (hv s hs).fun_sub (hw s hs)) + (sub_eq_zero.mpr h0) (sub_eq_zero.mpr h1) hLx hLv hsmall hres t ht + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Basic.lean b/LeanPool/PlanarMidpoint/Basic.lean new file mode 100644 index 0000000000..a54329ed72 --- /dev/null +++ b/LeanPool/PlanarMidpoint/Basic.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import Mathlib.Analysis.InnerProductSpace.PiL2 +public import Mathlib.Analysis.Calculus.FDeriv.Basic +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring + +/-! +# Planar symmetric cubic tensors + +The four entries are the coefficients `C₁₁₁, C₁₁₂, C₁₂₂, C₂₂₂` of a totally +symmetric cubic tensor. The Euclidean pairing identifies it with the bilinear +Christoffel tensor `K`. The derivative index in `obstruction` is unrestricted. +-/ + +@[expose] public section + +namespace PlanarMidpoint + +/-- The Euclidean plane with its standard inner product and norm. -/ +abbrev E := EuclideanSpace ℝ (Fin 2) +/-- The four independent coefficients of a totally symmetric planar cubic tensor. -/ +abbrev Coeff := Fin 4 → ℝ + +/-- The affine midpoint parameter, explicitly named to keep independent statements identical. -/ +noncomputable abbrev midpointTime : ℝ := 1 / 2 + +/-- A planar vector specified by its two standard coordinates. -/ +def vec (x y : ℝ) : E := !₂[x, y] + +@[simp] theorem vec_zero (x y : ℝ) : vec x y 0 = x := rfl +@[simp] theorem vec_one (x y : ℝ) : vec x y 1 = y := rfl + +theorem vec_ext {u v : E} (h₀ : u 0 = v 0) (h₁ : u 1 = v 1) : u = v := by + ext i + fin_cases i <;> assumption + +/-- The symmetric bilinear Christoffel tensor obtained by raising a cubic index. -/ +def K (c : Coeff) (u v : E) : E := + vec (c 0 * u 0 * v 0 + c 1 * (u 0 * v 1 + u 1 * v 0) + c 2 * u 1 * v 1) + (c 1 * u 0 * v 0 + c 2 * (u 0 * v 1 + u 1 * v 0) + c 3 * u 1 * v 1) + +/-- The symmetric trilinear form represented by the four cubic coefficients. -/ +def cubic (c : Coeff) (u v w : E) : ℝ := + c 0 * u 0 * v 0 * w 0 + c 1 * (u 0 * v 0 * w 1 + u 0 * v 1 * w 0 + u 1 * v 0 * w 0) + c 2 * (u 0 + * v 1 * w 1 + u 1 * v 0 * w 1 + u 1 * v 1 * w 0) + c 3 * u 1 * v 1 * w 1 + +/-- The contraction of a planar cubic tensor against the Euclidean metric. -/ +def trace (c : Coeff) : E := vec (c 0 + c 2) (c 1 + c 3) + +/-- The quartic midpoint obstruction with an unrestricted derivative slot. -/ +def obstruction (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : E := + 2 • K c h (K (J h) h h) + 5 • K (J (K c h h)) h h - 4 • K (J h) h (K c h h) + +theorem K_symm (c : Coeff) (u v : E) : K c u v = K c v u := by + apply vec_ext <;> simp [K] <;> ring + +theorem cubic_swap_left (c : Coeff) (u v w : E) : cubic c u v w = cubic c v u w := by + simp only [cubic] + ring + +theorem cubic_swap_right (c : Coeff) (u v w : E) : cubic c u v w = cubic c u w v := by + simp only [cubic] + ring + +theorem cubic_diagonal (c : Coeff) (u : E) : + cubic c u u u = c 0 * u 0 ^ 3 + 3 * c 1 * u 0 ^ 2 * u 1 + 3 * c 2 * u 0 * u 1 ^ 2 + c 3 * u 1 + ^ 3 := by + simp only [cubic] + ring + +theorem K_pairing (c : Coeff) (u v w : E) : + inner ℝ (K c u v) w = cubic c u v w := by + simp [EuclideanSpace.inner_eq_star_dotProduct, dotProduct, Fin.sum_univ_two, K, cubic] + ring + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/CanonicalMidpoints.lean b/LeanPool/PlanarMidpoint/CanonicalMidpoints.lean new file mode 100644 index 0000000000..610da9a59d --- /dev/null +++ b/LeanPool/PlanarMidpoint/CanonicalMidpoints.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.GeodesicBVP +public import LeanPool.PlanarMidpoint.MidpointGerms +public import Mathlib.Tactic.NormNum + +/-! +# Existence and restriction of canonical local midpoint maps + +The small geodesic branch is constructed by the boundary-value contraction. +Consequently canonical complementarity supplies complementary curves of +arbitrarily small position and velocity size, without endpoint regularity +as an additional hypothesis. +-/ + +@[expose] public section + +open Set Metric +open scoped ContDiff + +noncomputable section + +namespace PlanarMidpoint + +theorem exists_arbitrarily_short_geodesic {C : E → Coeff} {p : E} + (hC : ContDiffAt ℝ 1 C p) (σ : ℝ) (r : ℝ) (hr : 0 < r) : + ∃ δ > (0 : ℝ), ∀ P Q, P ∈ ball p δ → Q ∈ ball p δ → + ∃ γ v, IsShortGeodesic C σ p r P Q γ v := by + obtain ⟨s, hs, hsr, δ, hδ, hsol⟩ := exists_unique_short_geodesic hC σ r hr + refine ⟨δ, hδ, fun P Q hP hQ => ?_⟩ + obtain ⟨γ, v, hg, _⟩ := hsol P Q hP hQ + exact ⟨γ, v, hg.mono_radius hsr⟩ + +theorem localMidpointInvariance_arbitrarilyShort + {Ω : Set E} {C : E → Coeff} {p : E} + (hΩ : IsOpen Ω) (hp : p ∈ Ω) (hC : ContDiffOn ℝ 2 C Ω) + (hlocal : LocalMidpointInvariance Ω C) : ArbitrarilyShortComplementaryPairs C p := by + apply arbitrarilyShortPairs_of_canonical hlocal hp + intro σ _ r hr + apply exists_arbitrarily_short_geodesic _ σ r hr + exact ((hC p hp).contDiffAt (hΩ.mem_nhds hp)).of_le (by norm_num) + +/-- Smooth coefficient fields genuinely have canonical local midpoint maps; +the defining predicate is witnessed by the constructed short BVP branch. -/ +theorem exists_canonical_local_midpoint {Ω : Set E} {C : E → Coeff} {p : E} + (hΩ : IsOpen Ω) (hp : p ∈ Ω) (hC : ContDiffAt ℝ 1 C p) (σ : ℝ) : + ∃ r W A, IsCanonicalLocalMidpoint Ω C σ p r W A := by + classical + obtain ⟨η, hη, hηΩ⟩ := Metric.isOpen_iff.mp hΩ p hp + obtain ⟨r, hr, hrη, δ, hδ, hsol⟩ := exists_unique_short_geodesic hC σ η hη + let W : Set (E × E) := ball p δ ×ˢ ball p δ + let A : E → E → E := fun P Q => + if h : (P, Q) ∈ W then (Classical.choose (hsol P Q h.1 h.2)) (1 / 2) else 0 + refine ⟨r, W, A, hr, fun x hx => hηΩ (ball_subset_ball hrη hx), + isOpen_ball.prod isOpen_ball, ⟨mem_ball_self hδ, mem_ball_self hδ⟩, ?_⟩ + intro P Q hPQ + let sol := hsol P Q hPQ.1 hPQ.2 + refine ⟨Classical.choose sol, Classical.choose (Classical.choose_spec sol), + (Classical.choose_spec (Classical.choose_spec sol)).1, ?_, + (Classical.choose_spec (Classical.choose_spec sol)).2⟩ + simp only [A, dite_eq_left hPQ] + +/-- Any two canonical midpoint constructions for the same local connection +agree after restriction to a common open neighborhood of the diagonal point. +The comparison uses actual geodesics shorter than both defining radii. -/ +theorem canonical_midpoint_germs_agree + {Ω₁ Ω₂ : Set E} {C : E → Coeff} {σ : ℝ} {p : E} + {r₁ r₂ : ℝ} {W₁ W₂ : Set (E × E)} {A₁ A₂ : E → E → E} + (hC : ContDiffAt ℝ 1 C p) + (hA₁ : IsCanonicalLocalMidpoint Ω₁ C σ p r₁ W₁ A₁) + (hA₂ : IsCanonicalLocalMidpoint Ω₂ C σ p r₂ W₂ A₂) : + ∃ W : Set (E × E), IsOpen W ∧ (p, p) ∈ W ∧ W ⊆ W₁ ∩ W₂ ∧ + ∀ P Q, (P, Q) ∈ W → A₁ P Q = A₂ P Q := by + obtain ⟨hr₁, _, hW₁, hpp₁, hsol₁⟩ := hA₁ + obtain ⟨hr₂, _, hW₂, hpp₂, hsol₂⟩ := hA₂ + obtain ⟨δ, hδ, hsmall⟩ := exists_arbitrarily_short_geodesic hC σ + (min r₁ r₂) (lt_min hr₁ hr₂) + refine ⟨(W₁ ∩ W₂) ∩ (ball p δ ×ˢ ball p δ), + (hW₁.inter hW₂).inter (isOpen_ball.prod isOpen_ball), + ⟨⟨hpp₁, hpp₂⟩, mem_ball_self hδ, mem_ball_self hδ⟩, inter_subset_left, ?_⟩ + intro P Q hPQ + obtain ⟨γ, v, hg⟩ := hsmall P Q hPQ.2.1 hPQ.2.2 + obtain ⟨γ₁, v₁, _, hm₁, hu₁⟩ := hsol₁ P Q hPQ.1.1 + obtain ⟨γ₂, v₂, _, hm₂, hu₂⟩ := hsol₂ P Q hPQ.1.2 + have he₁ := (hu₁ γ v (hg.mono_radius (min_le_left _ _)) (1 / 2) (by norm_num)).1 + have he₂ := (hu₂ γ v (hg.mono_radius (min_le_right _ _)) (1 / 2) (by norm_num)).1 + rw [hm₁, hm₂, ← he₁, ← he₂] + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Coordinates.lean b/LeanPool/PlanarMidpoint/Coordinates.lean new file mode 100644 index 0000000000..afbc618e98 --- /dev/null +++ b/LeanPool/PlanarMidpoint/Coordinates.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import LeanPool.PlanarMidpoint.Algebra +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +/-! Exact coordinate semantics of the fourth-order obstruction. -/ + +@[expose] public section +namespace PlanarMidpoint + +/-- The eight entries of a linear map from planar vectors to cubic coefficients. -/ +abbrev DerivativeArray := Fin 8 → ℝ + +/-- The columns of a cubic derivative in the fixed Euclidean basis. -/ +def derivativeArray (J : E →L[ℝ] Coeff) : DerivativeArray := + ![J (vec 1 0) 0, J (vec 1 0) 1, J (vec 1 0) 2, J (vec 1 0) 3, + J (vec 0 1) 0, J (vec 0 1) 1, J (vec 0 1) 2, J (vec 0 1) 3] + +/-- Evaluation of a derivative represented by its eight coordinate entries. -/ +def arrayApply (z : DerivativeArray) (h : E) : Coeff := + ![z 0 * h 0 + z 4 * h 1, z 1 * h 0 + z 5 * h 1, + z 2 * h 0 + z 6 * h 1, z 3 * h 0 + z 7 * h 1] + +theorem vec_decomp (h : E) : h = h 0 • vec 1 0 + h 1 • vec 0 1 := by + apply vec_ext <;> simp [vec] + +theorem arrayApply_derivativeArray (J : E →L[ℝ] Coeff) (h : E) : + arrayApply (derivativeArray J) h = J h := by + have he : J h = h 0 • J (vec 1 0) + h 1 • J (vec 0 1) := by + conv_lhs => rw [vec_decomp h] + simp only [map_add, map_smul] + rw [he] + ext i + fin_cases i <;> simp [arrayApply, derivativeArray] <;> ring + +theorem derivativeArray_eq_zero_iff (J : E →L[ℝ] Coeff) : + derivativeArray J = 0 ↔ J = 0 := by + constructor + · intro h + ext v i + rw [← arrayApply_derivativeArray J v, h] + fin_cases i <;> simp [arrayApply] + · rintro rfl + simp [derivativeArray] + +/-- The midpoint obstruction expressed through coordinate derivative data. -/ +def arrayObstruction (c : Coeff) (z : DerivativeArray) (h : E) : E := + 2 • K c h (K (arrayApply z h) h h) + 5 • K (arrayApply z (K c h h)) h h - 4 • K (arrayApply z h) + h (K c h h) + +theorem arrayObstruction_derivativeArray (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : + arrayObstruction c (derivativeArray J) h = obstruction c J h := by + simp [arrayObstruction, obstruction, arrayApply_derivativeArray] + +/-- The ten scalar coefficients of the two homogeneous quartic obstruction components. -/ +def rows (c : Coeff) (z : DerivativeArray) : Fin 10 → ℝ := + ![3 * (c 0) * z 0 - 2 * (c 1) * z 1 + 5 * (c 1) * z 4, + 4 * (c 1) * z 0 + 8 * (c 1) * z 5 + z 1 * (10 * (c 0) - 6 * (c 2)) + z 4 * (-2 * (c 0) + 10 * + (c 2)), + 2 * (c 1) * z 3 + 5 * (c 1) * z 6 + (c 2) * z 0 + 14 * (c 2) * z 5 + z 1 * (16 * (c 1) - 4 * + (c 3)) + z 2 * (7 * (c 0) - 4 * (c 2)) + z 4 * (-6 * (c 1) + 5 * (c 3)), + 2 * (c 1) * z 7 + 6 * (c 2) * z 1 + 2 * (c 2) * z 3 - 4 * (c 2) * z 4 + z 2 * (12 * (c 1) - 4 + * (c 3)) + z 5 * (-4 * (c 1) + 6 * (c 3)) + z 6 * (2 * (c 0) + 6 * (c 2)), + 5 * (c 2) * z 2 - 4 * (c 2) * z 5 + 2 * (c 2) * z 7 + z 6 * (2 * (c 1) + (c 3)), + 2 * (c 1) * z 0 - 4 * (c 1) * z 2 + 5 * (c 1) * z 5 + z 1 * ((c 0) + 2 * (c 2)), + -4 * (c 1) * z 3 + 2 * (c 1) * z 4 + 6 * (c 1) * z 6 + 2 * (c 2) * z 0 + z 1 * (6 * (c 1) + 2 + * (c 3)) + z 2 * (6 * (c 0) - 4 * (c 2)) + z 5 * (-4 * (c 0) + 12 * (c 2)), + 14 * (c 1) * z 2 + (c 1) * z 7 + 5 * (c 2) * z 1 + 2 * (c 2) * z 4 + z 3 * (5 * (c 0) - 6 * (c + 2)) + z 5 * (-4 * (c 1) + 7 * (c 3)) + z 6 * (-4 * (c 0) + 16 * (c 2)), + 8 * (c 2) * z 2 + 4 * (c 2) * z 7 + z 3 * (10 * (c 1) - 2 * (c 3)) + z 6 * (-6 * (c 1) + 10 * + (c 3)), + 5 * (c 2) * z 3 - 2 * (c 2) * z 6 + 3 * (c 3) * z 7] + +theorem kernel_iff_rows (c : Coeff) (z : DerivativeArray) : + Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z ↔ ∀ i, rows c z i = 0 := by + simp [Algebra.Kernel, rows, Fin.forall_fin_succ] + +theorem arrayObstruction_component_0 (c : Coeff) (z : DerivativeArray) (h : E) : + arrayObstruction c z h 0 = rows c z 0 * h 0 ^ 4 * h 1 ^ 0 + rows c z 1 * h 0 ^ 3 * h 1 ^ 1 + + rows c z 2 * h 0 ^ 2 * h 1 ^ 2 + rows c z 3 * h 0 ^ 1 * h 1 ^ 3 + rows c z 4 * h 0 ^ 0 * h + 1 ^ 4 := by + simp [arrayObstruction, K, arrayApply, rows] + ring + +theorem arrayObstruction_component_1 (c : Coeff) (z : DerivativeArray) (h : E) : + arrayObstruction c z h 1 = rows c z 5 * h 0 ^ 4 * h 1 ^ 0 + rows c z 6 * h 0 ^ 3 * h 1 ^ 1 + + rows c z 7 * h 0 ^ 2 * h 1 ^ 2 + rows c z 8 * h 0 ^ 1 * h 1 ^ 3 + rows c z 9 * h 0 ^ 0 * h + 1 ^ 4 := by + simp [arrayObstruction, K, arrayApply, rows] + ring + +theorem quartic_coefficients_zero (a b c d e : ℝ) + (h : ∀ j : Fin 5, a * (j : ℝ) ^ 4 + b * (j : ℝ) ^ 3 + c * (j : ℝ) ^ 2 + d * (j : ℝ) + e = 0) : + a = 0 ∧ b = 0 ∧ c = 0 ∧ d = 0 ∧ e = 0 := by + have h0 := h 0 + have h1 := h 1 + have h2 := h 2 + have h3 := h 3 + have h4 := h 4 + norm_num at h0 h1 h2 h3 h4 + constructor + · linarith + constructor + · linarith + constructor + · linarith + constructor <;> linarith + +/-- Five samples determine whether the coordinate obstruction vanishes identically. -/ +theorem kernel_of_five_arrayObstruction_zero (c : Coeff) (z : DerivativeArray) + (htest : ∀ j : Fin 5, arrayObstruction c z (vec (j : ℝ) 1) = 0) : + Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z := by + apply (kernel_iff_rows c z).mpr + have h0 : ∀ j : Fin 5, + rows c z 0 * (j : ℝ) ^ 4 + rows c z 1 * (j : ℝ) ^ 3 + rows c z 2 * (j : ℝ) ^ 2 + rows c z + 3 * (j : ℝ) + rows c z 4 = 0 := by + intro j + simpa [arrayObstruction_component_0, vec] using + congrArg (fun v : E => v 0) (htest j) + have h1 : ∀ j : Fin 5, + rows c z 5 * (j : ℝ) ^ 4 + rows c z 6 * (j : ℝ) ^ 3 + rows c z 7 * (j : ℝ) ^ 2 + rows c z + 8 * (j : ℝ) + rows c z 9 = 0 := by + intro j + simpa [arrayObstruction_component_1, vec] using + congrArg (fun v : E => v 1) (htest j) + have hs0 := quartic_coefficients_zero _ _ _ _ _ h0 + have hs1 := quartic_coefficients_zero _ _ _ _ _ h1 + obtain ⟨h0, h1, h2, h3, h4⟩ := hs0 + obtain ⟨h5, h6, h7, h8, h9⟩ := hs1 + intro i + fin_cases i <;> assumption + +theorem kernel_iff_arrayObstruction_zero (c : Coeff) (z : DerivativeArray) : + Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z ↔ ∀ h, arrayObstruction c z h = 0 := by + constructor + · intro hk h + have hz := (kernel_iff_rows c z).mp hk + apply vec_ext + · simp [arrayObstruction_component_0, hz] + · simp [arrayObstruction_component_1, hz] + · intro hz + exact kernel_of_five_arrayObstruction_zero c z (fun j ↦ hz (vec (j : ℝ) 1)) + +theorem kernel_of_obstruction_zero (c : Coeff) (J : E →L[ℝ] Coeff) + (h : ∀ v, obstruction c J v = 0) : + Algebra.Kernel (c 0) (c 1) (c 2) (c 3) (derivativeArray J) := by + apply (kernel_iff_arrayObstruction_zero c (derivativeArray J)).mpr + simpa [arrayObstruction_derivativeArray] using h + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Covariance.lean b/LeanPool/PlanarMidpoint/Covariance.lean new file mode 100644 index 0000000000..059a0f585a --- /dev/null +++ b/LeanPool/PlanarMidpoint/Covariance.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Coordinates +public import LeanPool.PlanarMidpoint.ExceptionalGeometry +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.Ring + +/-! Fixed conformal changes of coordinates and the complete pointwise kernel classification. +No position-dependent frame is differentiated. -/ + +@[expose] public section +noncomputable section + +namespace PlanarMidpoint + + +/-- Pullback of a cubic tensor by a fixed conformal change of coordinates. -/ +def pullCoeff (s t : ℝ) (c : Coeff) : Coeff := + ![c 0 * s ^ 3 + 3 * c 1 * s ^ 2 * t + 3 * c 2 * s * t ^ 2 + c 3 * t ^ 3, + -c 0 * s ^ 2 * t + c 1 * (s ^ 3 - 2 * s * t ^ 2) + c 2 * (2 * s ^ 2 * t - t ^ 3) + c 3 * s * t + ^ 2, + c 0 * s * t ^ 2 + c 1 * (t ^ 3 - 2 * s ^ 2 * t) + c 2 * (s ^ 3 - 2 * s * t ^ 2) + c 3 * s ^ 2 + * t, + -c 0 * t ^ 3 + 3 * c 1 * s * t ^ 2 - 3 * c 2 * s ^ 2 * t + c 3 * s ^ 3] + +/-- Pullback of all four tensor indices of a cubic derivative. -/ +def pullDerivative (s t : ℝ) (z : DerivativeArray) : DerivativeArray := + let x := pullCoeff s t ![s * z 0 + t * z 4, s * z 1 + t * z 5, s * z 2 + t * z 6, s * z 3 + t * + z 7] + let y := pullCoeff s t ![-t * z 0 + s * z 4, -t * z 1 + s * z 5, -t * z 2 + s * z 6, -t * z 3 + + s * z 7] + ![x 0, x 1, x 2, x 3, y 0, y 1, y 2, y 3] + +theorem pullCoeff_inverse (s t : ℝ) (c : Coeff) : + pullCoeff s (-t) (pullCoeff s t c) = (s ^ 2 + t ^ 2) ^ 3 • c := by + ext i + fin_cases i <;> simp [pullCoeff] <;> ring + +theorem pullDerivative_inverse (s t : ℝ) (z : DerivativeArray) : + pullDerivative s (-t) (pullDerivative s t z) = (s ^ 2 + t ^ 2) ^ 4 • z := by + ext i + fin_cases i <;> simp [pullDerivative, pullCoeff] <;> ring + +theorem pullDerivative_ne_zero (s t : ℝ) (z : DerivativeArray) + (hr : s ^ 2 + t ^ 2 ≠ 0) (hz : z ≠ 0) : pullDerivative s t z ≠ 0 := by + intro he + have hi := pullDerivative_inverse s t z + rw [he] at hi + have hh : pullDerivative s (-t) 0 = 0 := by simp [pullDerivative, pullCoeff] + rw [hh] at hi + exact hz ((smul_eq_zero.mp hi.symm).resolve_left (pow_ne_zero 4 hr)) + +theorem kernel_pull (s t : ℝ) (c : Coeff) (z : DerivativeArray) + (h : Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z) : + Algebra.Kernel (pullCoeff s t c 0) (pullCoeff s t c 1) + (pullCoeff s t c 2) (pullCoeff s t c 3) (pullDerivative s t z) := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + unfold Algebra.Kernel + simp only [pullCoeff, pullDerivative, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · linear_combination (s ^ 7 + s ^ 5 * t ^ 2) * h0 + (s ^ 6 * t + s ^ 4 * t ^ 3) * h1 + (s ^ 5 * + t ^ 2 + s ^ 3 * t ^ 4) * h2 + (s ^ 4 * t ^ 3 + s ^ 2 * t ^ 5) * h3 + (s ^ 3 * t ^ 4 + s * t + ^ 6) * h4 + (s ^ 6 * t + s ^ 4 * t ^ 3) * h5 + (s ^ 5 * t ^ 2 + s ^ 3 * t ^ 4) * h6 + (s ^ 4 + * t ^ 3 + s ^ 2 * t ^ 5) * h7 + (s ^ 3 * t ^ 4 + s * t ^ 6) * h8 + (s ^ 2 * t ^ 5 + t ^ 7) * + h9 + · linear_combination (-4 * s ^ 6 * t - 4 * s ^ 4 * t ^ 3) * h0 + (s ^ 7 - 2 * s ^ 5 * t ^ 2 - 3 + * s ^ 3 * t ^ 4) * h1 + (2 * s ^ 6 * t - 2 * s ^ 2 * t ^ 5) * h2 + (3 * s ^ 5 * t ^ 2 + 2 * + s ^ 3 * t ^ 4 - s * t ^ 6) * h3 + (4 * s ^ 4 * t ^ 3 + 4 * s ^ 2 * t ^ 5) * h4 + (-4 * s ^ 5 + * t ^ 2 - 4 * s ^ 3 * t ^ 4) * h5 + (s ^ 6 * t - 2 * s ^ 4 * t ^ 3 - 3 * s ^ 2 * t ^ 5) * h6 + + (2 * s ^ 5 * t ^ 2 - 2 * s * t ^ 6) * h7 + (3 * s ^ 4 * t ^ 3 + 2 * s ^ 2 * t ^ 5 - t ^ 7) + * h8 + (4 * s ^ 3 * t ^ 4 + 4 * s * t ^ 6) * h9 + · linear_combination (6 * s ^ 5 * t ^ 2 + 6 * s ^ 3 * t ^ 4) * h0 + (-3 * s ^ 6 * t + 3 * s ^ 2 + * t ^ 5) * h1 + (s ^ 7 - 3 * s ^ 5 * t ^ 2 - 3 * s ^ 3 * t ^ 4 + s * t ^ 6) * h2 + (3 * s ^ + 6 * t - 3 * s ^ 2 * t ^ 5) * h3 + (6 * s ^ 5 * t ^ 2 + 6 * s ^ 3 * t ^ 4) * h4 + (6 * s ^ 4 + * t ^ 3 + 6 * s ^ 2 * t ^ 5) * h5 + (-3 * s ^ 5 * t ^ 2 + 3 * s * t ^ 6) * h6 + (s ^ 6 * t - + 3 * s ^ 4 * t ^ 3 - 3 * s ^ 2 * t ^ 5 + t ^ 7) * h7 + (3 * s ^ 5 * t ^ 2 - 3 * s * t ^ 6) * + h8 + (6 * s ^ 4 * t ^ 3 + 6 * s ^ 2 * t ^ 5) * h9 + · linear_combination (-4 * s ^ 4 * t ^ 3 - 4 * s ^ 2 * t ^ 5) * h0 + (3 * s ^ 5 * t ^ 2 + 2 * s + ^ 3 * t ^ 4 - s * t ^ 6) * h1 + (-2 * s ^ 6 * t + 2 * s ^ 2 * t ^ 5) * h2 + (s ^ 7 - 2 * s ^ + 5 * t ^ 2 - 3 * s ^ 3 * t ^ 4) * h3 + (4 * s ^ 6 * t + 4 * s ^ 4 * t ^ 3) * h4 + (-4 * s ^ 3 + * t ^ 4 - 4 * s * t ^ 6) * h5 + (3 * s ^ 4 * t ^ 3 + 2 * s ^ 2 * t ^ 5 - t ^ 7) * h6 + (-2 * + s ^ 5 * t ^ 2 + 2 * s * t ^ 6) * h7 + (s ^ 6 * t - 2 * s ^ 4 * t ^ 3 - 3 * s ^ 2 * t ^ 5) * + h8 + (4 * s ^ 5 * t ^ 2 + 4 * s ^ 3 * t ^ 4) * h9 + · linear_combination (s ^ 3 * t ^ 4 + s * t ^ 6) * h0 + (-s ^ 4 * t ^ 3 - s ^ 2 * t ^ 5) * h1 + + (s ^ 5 * t ^ 2 + s ^ 3 * t ^ 4) * h2 + (-s ^ 6 * t - s ^ 4 * t ^ 3) * h3 + (s ^ 7 + s ^ 5 * + t ^ 2) * h4 + (s ^ 2 * t ^ 5 + t ^ 7) * h5 + (-s ^ 3 * t ^ 4 - s * t ^ 6) * h6 + (s ^ 4 * t + ^ 3 + s ^ 2 * t ^ 5) * h7 + (-s ^ 5 * t ^ 2 - s ^ 3 * t ^ 4) * h8 + (s ^ 6 * t + s ^ 4 * t ^ + 3) * h9 + · linear_combination (-s ^ 6 * t - s ^ 4 * t ^ 3) * h0 + (-s ^ 5 * t ^ 2 - s ^ 3 * t ^ 4) * h1 + + (-s ^ 4 * t ^ 3 - s ^ 2 * t ^ 5) * h2 + (-s ^ 3 * t ^ 4 - s * t ^ 6) * h3 + (-s ^ 2 * t ^ 5 + - t ^ 7) * h4 + (s ^ 7 + s ^ 5 * t ^ 2) * h5 + (s ^ 6 * t + s ^ 4 * t ^ 3) * h6 + (s ^ 5 * t + ^ 2 + s ^ 3 * t ^ 4) * h7 + (s ^ 4 * t ^ 3 + s ^ 2 * t ^ 5) * h8 + (s ^ 3 * t ^ 4 + s * t ^ + 6) * h9 + · linear_combination (4 * s ^ 5 * t ^ 2 + 4 * s ^ 3 * t ^ 4) * h0 + (-s ^ 6 * t + 2 * s ^ 4 * t + ^ 3 + 3 * s ^ 2 * t ^ 5) * h1 + (-2 * s ^ 5 * t ^ 2 + 2 * s * t ^ 6) * h2 + (-3 * s ^ 4 * t + ^ 3 - 2 * s ^ 2 * t ^ 5 + t ^ 7) * h3 + (-4 * s ^ 3 * t ^ 4 - 4 * s * t ^ 6) * h4 + (-4 * s + ^ 6 * t - 4 * s ^ 4 * t ^ 3) * h5 + (s ^ 7 - 2 * s ^ 5 * t ^ 2 - 3 * s ^ 3 * t ^ 4) * h6 + + (2 * s ^ 6 * t - 2 * s ^ 2 * t ^ 5) * h7 + (3 * s ^ 5 * t ^ 2 + 2 * s ^ 3 * t ^ 4 - s * t ^ + 6) * h8 + (4 * s ^ 4 * t ^ 3 + 4 * s ^ 2 * t ^ 5) * h9 + · linear_combination (-6 * s ^ 4 * t ^ 3 - 6 * s ^ 2 * t ^ 5) * h0 + (3 * s ^ 5 * t ^ 2 - 3 * s + * t ^ 6) * h1 + (-s ^ 6 * t + 3 * s ^ 4 * t ^ 3 + 3 * s ^ 2 * t ^ 5 - t ^ 7) * h2 + (-3 * s + ^ 5 * t ^ 2 + 3 * s * t ^ 6) * h3 + (-6 * s ^ 4 * t ^ 3 - 6 * s ^ 2 * t ^ 5) * h4 + (6 * s ^ + 5 * t ^ 2 + 6 * s ^ 3 * t ^ 4) * h5 + (-3 * s ^ 6 * t + 3 * s ^ 2 * t ^ 5) * h6 + (s ^ 7 - 3 + * s ^ 5 * t ^ 2 - 3 * s ^ 3 * t ^ 4 + s * t ^ 6) * h7 + (3 * s ^ 6 * t - 3 * s ^ 2 * t ^ 5) + * h8 + (6 * s ^ 5 * t ^ 2 + 6 * s ^ 3 * t ^ 4) * h9 + · linear_combination (4 * s ^ 3 * t ^ 4 + 4 * s * t ^ 6) * h0 + (-3 * s ^ 4 * t ^ 3 - 2 * s ^ 2 + * t ^ 5 + t ^ 7) * h1 + (2 * s ^ 5 * t ^ 2 - 2 * s * t ^ 6) * h2 + (-s ^ 6 * t + 2 * s ^ 4 * + t ^ 3 + 3 * s ^ 2 * t ^ 5) * h3 + (-4 * s ^ 5 * t ^ 2 - 4 * s ^ 3 * t ^ 4) * h4 + (-4 * s ^ + 4 * t ^ 3 - 4 * s ^ 2 * t ^ 5) * h5 + (3 * s ^ 5 * t ^ 2 + 2 * s ^ 3 * t ^ 4 - s * t ^ 6) * + h6 + (-2 * s ^ 6 * t + 2 * s ^ 2 * t ^ 5) * h7 + (s ^ 7 - 2 * s ^ 5 * t ^ 2 - 3 * s ^ 3 * t + ^ 4) * h8 + (4 * s ^ 6 * t + 4 * s ^ 4 * t ^ 3) * h9 + · linear_combination (-s ^ 2 * t ^ 5 - t ^ 7) * h0 + (s ^ 3 * t ^ 4 + s * t ^ 6) * h1 + (-s ^ 4 + * t ^ 3 - s ^ 2 * t ^ 5) * h2 + (s ^ 5 * t ^ 2 + s ^ 3 * t ^ 4) * h3 + (-s ^ 6 * t - s ^ 4 * + t ^ 3) * h4 + (s ^ 3 * t ^ 4 + s * t ^ 6) * h5 + (-s ^ 4 * t ^ 3 - s ^ 2 * t ^ 5) * h6 + (s + ^ 5 * t ^ 2 + s ^ 3 * t ^ 4) * h7 + (-s ^ 6 * t - s ^ 4 * t ^ 3) * h8 + (s ^ 7 + s ^ 5 * t ^ + 2) * h9 + +theorem kernel_smul_coeff (r : ℝ) (c : Coeff) (z : DerivativeArray) + (h : Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z) : + Algebra.Kernel ((r • c) 0) ((r • c) 1) ((r • c) 2) ((r • c) 3) z := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + simp only [Pi.smul_apply, smul_eq_mul] + unfold Algebra.Kernel + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · linear_combination r * h0 + · linear_combination r * h1 + · linear_combination r * h2 + · linear_combination r * h3 + · linear_combination r * h4 + · linear_combination r * h5 + · linear_combination r * h6 + · linear_combination r * h7 + · linear_combination r * h8 + · linear_combination r * h9 + +/-- Normalize a nonzero trace by a fixed conformal pullback. -/ +def normalizedCoeff (c : Coeff) : Coeff := + (radiusSq (trace c) ^ 2)⁻¹ • pullCoeff (trace c 0) (trace c 1) c + +theorem normalizedCoeff_trace (c : Coeff) (ht : trace c ≠ 0) : + normalizedCoeff c 0 + normalizedCoeff c 2 = 1 ∧ + normalizedCoeff c 1 + normalizedCoeff c 3 = 0 := by + have hr := radiusSq_ne_zero ht + constructor <;> simp [normalizedCoeff, pullCoeff, trace, radiusSq] <;> + field_simp [show (c 0 + c 2) ^ 2 + (c 1 + c 3) ^ 2 ≠ 0 from hr] <;> ring + +theorem pullCoeff_smul (s t r : ℝ) (c : Coeff) : + pullCoeff s t (r • c) = r • pullCoeff s t c := by + ext i + fin_cases i <;> simp [pullCoeff] <;> ring + +theorem inverse_normalizedCoeff (c : Coeff) (ht : trace c ≠ 0) : + pullCoeff (trace c 0) (-(trace c 1)) (normalizedCoeff c) = + radiusSq (trace c) • c := by + have hr := radiusSq_ne_zero ht + rw [normalizedCoeff, pullCoeff_smul, pullCoeff_inverse, smul_smul] + congr 1 + change (radiusSq (trace c) ^ 2)⁻¹ * radiusSq (trace c) ^ 3 = radiusSq (trace c) + field_simp + +theorem eq_Q_of_normalizedCoeff (c : Coeff) (ht : trace c ≠ 0) + (hn : normalizedCoeff c = ![1, 0, 0, 0]) : c = Q (trace c) := by + have hi := inverse_normalizedCoeff c ht + rw [hn] at hi + have hr := radiusSq_ne_zero ht + ext i + have he := congrFun hi i + fin_cases i <;> simp only [pullCoeff, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, + Matrix.cons_val_zero, one_mul, Matrix.cons_val_one, mul_zero, zero_mul, mul_neg, + neg_zero, add_zero, Matrix.cons_val, even_two, Even.neg_pow, neg_mul, neg_neg, + sub_neg_eq_add, sub_zero, Fin.zero_eta, Fin.mk_one, Fin.reduceFinMk, Pi.smul_apply, + smul_eq_mul, Q] at he ⊢ <;> + apply (eq_div_iff hr).mpr <;> nlinarith only [he] + +theorem eq_R_of_normalizedCoeff (c : Coeff) (ht : trace c ≠ 0) + (hn : normalizedCoeff c = ![0, 0, 1, 0]) : c = R (trace c) := by + have hi := inverse_normalizedCoeff c ht + rw [hn] at hi + have hr := radiusSq_ne_zero ht + ext i + have he := congrFun hi i + fin_cases i <;> simp [pullCoeff, R, Q] at he ⊢ <;> + field_simp [hr] <;> simp only [radiusSq] at he ⊢ <;> nlinarith only [he] + +/-- Complete pointwise classification: a nonzero kernel at a nonzero cubic +forces one of the two exceptional graphs. -/ +theorem exceptional_of_kernel (c : Coeff) (z : DerivativeArray) + (hc : c ≠ 0) (hz : z ≠ 0) + (h : Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z) : + trace c ≠ 0 ∧ (c = Q (trace c) ∨ c = R (trace c)) := by + have ht : trace c ≠ 0 := by + intro ht + have hs := congrArg (fun v : E => v 0) ht + have ht' := congrArg (fun v : E => v 1) ht + simp only [Fin.isValue, trace, vec_zero, PiLp.zero_apply, vec_one] at hs ht' + have h2 : c 2 = -c 0 := by linarith only [hs] + have h3 : c 3 = -c 1 := by linarith only [ht'] + have hab : c 0 ≠ 0 ∨ c 1 ≠ 0 := by + by_contra hh + push Not at hh + apply hc + ext i + fin_cases i <;> simp [hh.1, hh.2, h2, h3] + rw [h2, h3] at h + exact hz (Algebra.tracefree_injective (c 0) (c 1) z h hab) + refine ⟨ht, ?_⟩ + let z' := pullDerivative (trace c 0) (trace c 1) z + have hz' : z' ≠ 0 := pullDerivative_ne_zero _ _ z (radiusSq_ne_zero ht) hz + have hn := kernel_smul_coeff ((radiusSq (trace c) ^ 2)⁻¹) _ _ + (kernel_pull (trace c 0) (trace c 1) c z h) + change Algebra.Kernel (normalizedCoeff c 0) (normalizedCoeff c 1) + (normalizedCoeff c 2) (normalizedCoeff c 3) z' at hn + obtain ⟨ht0, ht1⟩ := normalizedCoeff_trace c ht + have h2 : normalizedCoeff c 2 = 1 - normalizedCoeff c 0 := by linarith only [ht0] + have h3 : normalizedCoeff c 3 = -normalizedCoeff c 1 := by linarith only [ht1] + rw [h2, h3] at hn + obtain ⟨hb, ha|ha⟩ := Algebra.normalized_classification _ _ z' hn hz' + · right + apply eq_R_of_normalizedCoeff c ht + ext i + fin_cases i <;> simp [ha, hb, h2, h3] + · left + apply eq_Q_of_normalizedCoeff c ht + ext i + fin_cases i <;> simp [ha, hb, h2, h3] + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/DifferentialRigidity.lean b/LeanPool/PlanarMidpoint/DifferentialRigidity.lean new file mode 100644 index 0000000000..5ed0ab695d --- /dev/null +++ b/LeanPool/PlanarMidpoint/DifferentialRigidity.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Covariance +public import LeanPool.PlanarMidpoint.TangentGeometry +public import LeanPool.PlanarMidpoint.Topology +public import Mathlib.Tactic.Continuity +public import Mathlib.Tactic.FinCases + +/-! +# Differential rigidity of planar symmetric cubic fields + +On every open preconnected planar domain, an everywhere differentiable cubic +field satisfying the quartic obstruction equation is constant. The proof +includes the exceptional cones, transitions between loci, and zero values; +no continuity of the derivative is assumed. +-/ + +@[expose] public section + +open Set Filter + +namespace PlanarMidpoint + +noncomputable section + +/-- Values outside the two exceptional graphs. -/ +def regularLocus : Set Coeff := {c | c ≠ Q (trace c) ∧ c ≠ R (trace c)} + +theorem isOpen_regularLocus : IsOpen regularLocus := + (isOpen_ne_fun continuous_id (continuous_Q.comp continuous_trace)).inter + (isOpen_ne_fun continuous_id (continuous_R.comp continuous_trace)) + +theorem regular_obstruction_injective {c : Coeff} (hc : c ∈ regularLocus) + (J : E →L[ℝ] Coeff) (hJ : ∀ v, obstruction c J v = 0) : J = 0 := by + by_contra hne + have hc0 : c ≠ 0 := by + intro he + subst c + exact hc.1 (by ext i; fin_cases i <;> simp [trace, Q, radiusSq]) + have hz : derivativeArray J ≠ 0 := by + intro hz + exact hne ((derivativeArray_eq_zero_iff J).mp hz) + obtain ⟨_, hQ | hR⟩ := exceptional_of_kernel c (derivativeArray J) hc0 hz + (kernel_of_obstruction_zero c J hJ) + · exact hc.1 hQ + · exact hc.2 hR + +private theorem graph_or_graph {c : Coeff} (hc : c ∉ regularLocus) : + c = Q (trace c) ∨ c = R (trace c) := by + simp only [regularLocus, mem_ofPred_eq, not_and_or, not_not] at hc + exact hc + +private theorem trace_ne_zero_of_graph {c : Coeff} (hc : c ≠ 0) + (h : c = Q (trace c) ∨ c = R (trace c)) : trace c ≠ 0 := by + intro ht + rcases h with h | h + · rw [ht, Q_zero] at h + exact hc h + · rw [ht, R_zero] at h + exact hc h + +private theorem exceptional_fderiv_zero + (Ω : Set E) (C : E → Coeff) (hΩ : IsOpen Ω) + (hC : DifferentiableOn ℝ C Ω) + (hpde : ∀ p ∈ Ω, ∀ h, obstruction (C p) (fderiv ℝ C p) h = 0) + (houtside : ∀ p ∈ Ω, C p ∉ regularLocus) + (p : E) (hp : p ∈ Ω) (hne : C p ≠ 0) : fderiv ℝ C p = 0 := by + have hd : DifferentiableAt ℝ C p := (hC p hp).differentiableAt (hΩ.mem_nhds hp) + have hc := hd.continuousAt + have hb := graph_or_graph (houtside p hp) + have ht := trace_ne_zero_of_graph hne hb + have hlocal : ∀ᶠ q in nhds p, C q = Q (trace (C q)) ∨ C q = R (trace (C q)) := by + filter_upwards [hΩ.mem_nhds hp] with q hq + exact graph_or_graph (houtside q hq) + let A : E →L[ℝ] E := traceCLM.comp (fderiv ℝ C p) + have htrace : HasFDerivAt (fun q => trace (C q)) A p := by + simpa only [Function.comp_def, traceCLM_apply] using traceCLM.hasFDerivAt.comp p hd.hasFDerivAt + rcases hb with hQ | hR + · have heq : C =ᶠ[nhds p] (fun q => Q (trace (C q))) := + eventually_eq_left_branch hc (continuous_R.continuousAt.comp + (continuous_trace.continuousAt.comp hc)) + (Q_ne_R ht) hQ hlocal + have hdQ := (hasFDerivAt_Q ht).comp p htrace + have he : fderiv ℝ C p = (QDeriv (trace (C p))).comp A := + heq.fderiv_eq.trans hdQ.fderiv + rw [he] + apply Q_tangent_obstruction_zero ht A + simpa only [← he, ← hQ] using hpde p hp + · have hlocal' : ∀ᶠ q in nhds p, C q = R (trace (C q)) ∨ C q = Q (trace (C q)) := + hlocal.mono (fun _ h => h.symm) + have heq : C =ᶠ[nhds p] (fun q => R (trace (C q))) := + eventually_eq_left_branch hc (continuous_Q.continuousAt.comp + (continuous_trace.continuousAt.comp hc)) + (Ne.symm (Q_ne_R ht)) hR hlocal' + have hdR := (hasFDerivAt_R ht).comp p htrace + have he : fderiv ℝ C p = (RDeriv (trace (C p))).comp A := + heq.fderiv_eq.trans hdR.fderiv + rw [he] + apply R_tangent_obstruction_zero ht A + simpa only [← he, ← hR] using hpde p hp + +/-- The quartic obstruction forces a differentiable planar cubic field to be +constant on every open preconnected domain. -/ +theorem planar_obstruction_rigidity + (Ω : Set E) (C : E → Coeff) + (openΩ : IsOpen Ω) (connectedΩ : IsPreconnected Ω) + (diffC : DifferentiableOn ℝ C Ω) + (PDE : ∀ p ∈ Ω, ∀ h, obstruction (C p) (fderiv ℝ C p) h = 0) : + ∃ c : Coeff, ∀ p ∈ Ω, C p = c := by + apply exists_is_const_of_regular_locus openΩ connectedΩ diffC regularLocus isOpen_regularLocus + · intro p hp hregular + exact regular_obstruction_injective hregular (fderiv ℝ C p) (PDE p hp) + · exact exceptional_fderiv_zero Ω C openΩ diffC PDE + +end +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/ExceptionalGeometry.lean b/LeanPool/PlanarMidpoint/ExceptionalGeometry.lean new file mode 100644 index 0000000000..cb41712e79 --- /dev/null +++ b/LeanPool/PlanarMidpoint/ExceptionalGeometry.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Analysis.Calculus.Deriv.Inv +public import Mathlib.Analysis.Calculus.FDeriv.Pi +public import Mathlib.Analysis.Calculus.FDeriv.Pow +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.Ring + +/-! +# The two exceptional cubic graphs + +The rational graphs are defined everywhere, but all calculus statements carry +an explicit nonzero trace hypothesis. Their tangent maps are given in fixed +Euclidean coordinates. +-/ + +@[expose] public section + +namespace PlanarMidpoint + +noncomputable section + +/-- The squared Euclidean length of the trace vector. -/ +def radiusSq (τ : E) : ℝ := τ 0 ^ 2 + τ 1 ^ 2 + +/-- The pure-cube exceptional graph, extended by zero at zero trace. -/ +def Q (τ : E) : Coeff := + ![τ 0 ^ 3 / radiusSq τ, τ 0 ^ 2 * τ 1 / radiusSq τ, + τ 0 * τ 1 ^ 2 / radiusSq τ, τ 1 ^ 3 / radiusSq τ] + +/-- The second exceptional cubic graph, extended by zero at zero trace. -/ +def R (τ : E) : Coeff := + ![3 * τ 0 - 3 * Q τ 0, τ 1 - 3 * Q τ 1, + τ 0 - 3 * Q τ 2, 3 * τ 1 - 3 * Q τ 3] + +theorem radiusSq_pos {τ : E} (hτ : τ ≠ 0) : 0 < radiusSq τ := by + have hn : τ 0 ≠ 0 ∨ τ 1 ≠ 0 := by + by_contra h + push Not at h + exact hτ (vec_ext h.1 h.2) + rcases hn with h | h <;> unfold radiusSq <;> positivity + +theorem radiusSq_ne_zero {τ : E} (hτ : τ ≠ 0) : radiusSq τ ≠ 0 := + ne_of_gt (radiusSq_pos hτ) + +theorem trace_Q {τ : E} (hτ : τ ≠ 0) : trace (Q τ) = τ := by + have hρ := radiusSq_ne_zero hτ + apply vec_ext + · change τ 0 ^ 3 / radiusSq τ + τ 0 * τ 1 ^ 2 / radiusSq τ = τ 0 + field_simp + simp [radiusSq] + · change τ 0 ^ 2 * τ 1 / radiusSq τ + τ 1 ^ 3 / radiusSq τ = τ 1 + field_simp + simp [radiusSq] + +theorem trace_R {τ : E} (hτ : τ ≠ 0) : trace (R τ) = τ := by + have hρ := radiusSq_ne_zero hτ + apply vec_ext <;> simp [trace, R, Q] <;> field_simp <;> simp [radiusSq] + +theorem cubic_Q_trace {τ : E} (hτ : τ ≠ 0) : + cubic (Q τ) τ τ τ = radiusSq τ ^ 2 := by + have hρ := radiusSq_ne_zero hτ + simp [cubic, Q] + field_simp + simp [radiusSq] + ring + +theorem cubic_R_trace {τ : E} (hτ : τ ≠ 0) : + cubic (R τ) τ τ τ = 0 := by + have hρ := radiusSq_ne_zero hτ + simp [cubic, R, Q] + field_simp + simp [radiusSq] + ring + +theorem Q_ne_R {τ : E} (hτ : τ ≠ 0) : Q τ ≠ R τ := by + intro he + have h := congrArg (fun c => cubic c τ τ τ) he + rw [cubic_Q_trace hτ, cubic_R_trace hτ] at h + exact (pow_ne_zero 2 (radiusSq_ne_zero hτ)) h + +/-- Continuous linear evaluation of a standard Euclidean coordinate. -/ +def pr (i : Fin 2) : E →L[ℝ] ℝ := EuclideanSpace.proj i + +/-- Numerators of the four rows of the derivative of `Q`. -/ +def QNum (τ : E) : Fin 4 → Fin 2 → ℝ := + ![![τ 0 ^ 2 * (τ 0 ^ 2 + 3 * τ 1 ^ 2), -2 * τ 0 ^ 3 * τ 1], + ![2 * τ 0 * τ 1 ^ 3, τ 0 ^ 2 * (τ 0 ^ 2 - τ 1 ^ 2)], + ![τ 1 ^ 2 * (τ 1 ^ 2 - τ 0 ^ 2), 2 * τ 0 ^ 3 * τ 1], + ![-2 * τ 0 * τ 1 ^ 3, τ 1 ^ 2 * (3 * τ 0 ^ 2 + τ 1 ^ 2)]] + +/-- The derivative of the pure-cube graph away from zero trace. -/ +def QDeriv (τ : E) : E →L[ℝ] Coeff := + ContinuousLinearMap.pi fun i => + ((radiusSq τ ^ 2)⁻¹ * QNum τ i 0) • pr 0 + ((radiusSq τ ^ 2)⁻¹ * QNum τ i 1) • pr 1 + +theorem QDeriv_apply (τ v : E) (i : Fin 4) : + QDeriv τ v i = (QNum τ i 0 * v 0 + QNum τ i 1 * v 1) / radiusSq τ ^ 2 := by + simp [QDeriv, pr, div_eq_mul_inv] + ring + +theorem hasFDerivAt_Q {τ : E} (hτ : τ ≠ 0) : HasFDerivAt Q (QDeriv τ) τ := by + have hρ := radiusSq_ne_zero hτ + have h0 : HasFDerivAt (fun x : E => x 0) (pr 0) τ := (pr 0).hasFDerivAt + have h1 : HasFDerivAt (fun x : E => x 1) (pr 1) τ := (pr 1).hasFDerivAt + have hr := (h0.pow 2).add (h1.pow 2) + have hi := (hasDerivAt_inv hρ).comp_hasFDerivAt τ hr + change HasFDerivAt (fun τ i => Q τ i) _ τ + apply hasFDerivAt_pi.mpr + intro i + fin_cases i + · convert (h0.pow 3).mul hi using 1 + · ext x; simp [Q, radiusSq, div_eq_mul_inv] + · ext v; simp [QNum, pr]; field_simp [hρ]; simp [radiusSq]; ring_nf; simp + · convert ((h0.pow 2).mul h1).mul hi using 1 + · ext x; simp [Q, radiusSq, div_eq_mul_inv] + · ext v; simp [QNum, pr]; field_simp [hρ]; simp [radiusSq]; ring_nf; simp + · convert (h0.mul (h1.pow 2)).mul hi using 1 + · ext x; simp [Q, radiusSq, div_eq_mul_inv] + · ext v; simp [QNum, pr]; field_simp [hρ]; simp [radiusSq]; ring_nf; simp + · convert (h1.pow 3).mul hi using 1 + · ext x; simp [Q, radiusSq, div_eq_mul_inv] + · ext v; simp [QNum, pr]; field_simp [hρ]; simp [radiusSq]; ring_nf; simp + +/-- The linear part of the second exceptional graph. -/ +def linearR : E →L[ℝ] Coeff := + ContinuousLinearMap.pi ![3 • pr 0, pr 1, pr 0, 3 • pr 1] + +/-- The derivative of the second exceptional graph away from zero trace. -/ +def RDeriv (τ : E) : E →L[ℝ] Coeff := linearR - 3 • QDeriv τ + +/-- Numerators of the tangent map to the second exceptional graph. -/ +def RNum (τ : E) : Fin 4 → Fin 2 → ℝ := + ![![-3 * (τ 0) ^ 2 * (τ 1) ^ 2 + 3 * (τ 1) ^ 4, 6 * (τ 0) ^ 3 * (τ 1)], + ![-6 * (τ 0) * (τ 1) ^ 3, -2 * (τ 0) ^ 4 + 5 * (τ 0) ^ 2 * (τ 1) ^ 2 + (τ 1) ^ 4], + ![(τ 0) ^ 4 + 5 * (τ 0) ^ 2 * (τ 1) ^ 2 - 2 * (τ 1) ^ 4, -6 * (τ 0) ^ 3 * (τ 1)], + ![6 * (τ 0) * (τ 1) ^ 3, 3 * (τ 0) ^ 4 - 3 * (τ 0) ^ 2 * (τ 1) ^ 2]] + +theorem hasFDerivAt_R {τ : E} (hτ : τ ≠ 0) : HasFDerivAt R (RDeriv τ) τ := by + convert linearR.hasFDerivAt.sub ((hasFDerivAt_Q hτ).const_smul 3) using 1 + · ext x i + fin_cases i <;> simp [linearR, R, pr] + · rfl + +theorem RDeriv_apply {τ : E} (hτ : τ ≠ 0) (v : E) (i : Fin 4) : + RDeriv τ v i = (RNum τ i 0 * v 0 + RNum τ i 1 * v 1) / radiusSq τ ^ 2 := by + have hρ := radiusSq_ne_zero hτ + fin_cases i <;> simp [RDeriv, linearR, QDeriv, QNum, RNum, pr] <;> + field_simp [hρ] <;> simp [radiusSq] <;> ring_nf + +/-- The trace map is a fixed continuous linear map. -/ +def traceCLM : Coeff →L[ℝ] E := + ((ContinuousLinearMap.proj 0 : Coeff →L[ℝ] ℝ) + ContinuousLinearMap.proj 2).smulRight (vec 1 0) + + ((ContinuousLinearMap.proj 1 : Coeff →L[ℝ] ℝ) + ContinuousLinearMap.proj 3).smulRight (vec + 0 1) + +@[simp] theorem traceCLM_apply (c : Coeff) : traceCLM c = trace c := by + apply vec_ext <;> simp [traceCLM, trace, vec] + +theorem continuous_trace : Continuous trace := by + convert traceCLM.continuous using 1 + funext c + exact (traceCLM_apply c).symm + +theorem differentiableAt_Q {τ : E} (hτ : τ ≠ 0) : DifferentiableAt ℝ Q τ := + (hasFDerivAt_Q hτ).differentiableAt + +theorem differentiableAt_R {τ : E} (hτ : τ ≠ 0) : DifferentiableAt ℝ R τ := + (hasFDerivAt_R hτ).differentiableAt + +theorem continuousAt_Q {τ : E} (hτ : τ ≠ 0) : ContinuousAt Q τ := + (differentiableAt_Q hτ).continuousAt + +theorem continuousAt_R {τ : E} (hτ : τ ≠ 0) : ContinuousAt R τ := + (differentiableAt_R hτ).continuousAt + +private theorem abs_sq_mul_div_le (s t u : ℝ) : + |s ^ 2 * u / (s ^ 2 + t ^ 2)| ≤ |u| := by + have hρ : 0 ≤ s ^ 2 + t ^ 2 := by positivity + by_cases hz : s ^ 2 + t ^ 2 = 0 + · simp [hz] + have hp : 0 < s ^ 2 + t ^ 2 := lt_of_le_of_ne hρ (Ne.symm hz) + rw [abs_div, abs_mul, abs_sq, abs_of_pos hp] + apply (div_le_iff₀ hp).mpr + nlinarith [mul_nonneg (sq_nonneg t) (abs_nonneg u)] + +theorem norm_Q_le (τ : E) : ‖Q τ‖ ≤ ‖τ‖ := by + apply (pi_norm_le_iff_of_nonneg (norm_nonneg τ)).mpr + intro i + have h0 : |τ 0| ≤ ‖τ‖ := by simpa using PiLp.norm_apply_le τ 0 + have h1 : |τ 1| ≤ ‖τ‖ := by simpa using PiLp.norm_apply_le τ 1 + fin_cases i + · change |τ 0 ^ 3 / radiusSq τ| ≤ ‖τ‖ + simpa only [radiusSq, pow_succ] using + (abs_sq_mul_div_le (τ 0) (τ 1) (τ 0)).trans h0 + · change |τ 0 ^ 2 * τ 1 / radiusSq τ| ≤ ‖τ‖ + exact (abs_sq_mul_div_le (τ 0) (τ 1) (τ 1)).trans h1 + · change |τ 0 * τ 1 ^ 2 / radiusSq τ| ≤ ‖τ‖ + simpa only [radiusSq, mul_comm, add_comm] using + (abs_sq_mul_div_le (τ 1) (τ 0) (τ 0)).trans h0 + · change |τ 1 ^ 3 / radiusSq τ| ≤ ‖τ‖ + simpa only [radiusSq, pow_succ, add_comm] using + (abs_sq_mul_div_le (τ 1) (τ 0) (τ 1)).trans h1 + +@[simp] theorem Q_zero : Q 0 = 0 := by + ext i + fin_cases i <;> simp [Q, radiusSq] + +@[simp] theorem R_zero : R 0 = 0 := by + ext i + fin_cases i <;> simp [R] + +/-- The rational expression has a continuous extension through the zero trace. -/ +theorem continuous_Q : Continuous Q := by + apply continuous_iff_continuousAt.mpr + intro τ + by_cases hτ : τ = 0 + · subst τ + change Filter.Tendsto Q (nhds 0) (nhds (Q 0)) + rw [Q_zero] + exact squeeze_zero_norm norm_Q_le (by simpa only [norm_zero] using (continuous_norm.tendsto (0 + : E))) + · exact continuousAt_Q hτ + +theorem continuous_R : Continuous R := by + have h := linearR.continuous.sub (continuous_Q.const_smul (3 : ℝ)) + convert h using 1 + ext x i + fin_cases i <;> simp [linearR, R, pr] + +end +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/FiveDirections.lean b/LeanPool/PlanarMidpoint/FiveDirections.lean new file mode 100644 index 0000000000..abd845d09a --- /dev/null +++ b/LeanPool/PlanarMidpoint/FiveDirections.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.DifferentialRigidity +public import Mathlib.Tactic.FinCases + +/-! Five exact direction tests determine the quartic obstruction at each point. -/ + +@[expose] public section +namespace PlanarMidpoint + +/-- Five fixed directions suffice because each obstruction component is quartic. -/ +theorem obstruction_zero_of_five (c : Coeff) (J : E →L[ℝ] Coeff) + (htest : ∀ j : Fin 5, obstruction c J (vec (j : ℝ) 1) = 0) : + ∀ h : E, obstruction c J h = 0 := by + have hk := kernel_of_five_arrayObstruction_zero c (derivativeArray J) (fun j ↦ by + simpa only [arrayObstruction_derivativeArray] using htest j) + intro h + simpa only [arrayObstruction_derivativeArray] using + (kernel_iff_arrayObstruction_zero c (derivativeArray J)).mp hk h + +/-- Exact tests in the five directions `(j,1)`, at every point of the domain, +force a differentiable planar cubic field to be constant. -/ +theorem planar_five_direction_rigidity + (Ω : Set E) (C : E → Coeff) + (openΩ : IsOpen Ω) (connectedΩ : IsPreconnected Ω) + (diffC : DifferentiableOn ℝ C Ω) + (tests : ∀ p ∈ Ω, ∀ j : Fin 5, + obstruction (C p) (fderiv ℝ C p) (vec (j : ℝ) 1) = 0) : + ∃ c : Coeff, ∀ p ∈ Ω, C p = c := by + apply planar_obstruction_rigidity Ω C openΩ connectedΩ diffC + intro p hp + exact obstruction_zero_of_five (C p) (fderiv ℝ C p) (tests p hp) + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GeodesicBVP.lean b/LeanPool/PlanarMidpoint/GeodesicBVP.lean new file mode 100644 index 0000000000..6a6b8acc59 --- /dev/null +++ b/LeanPool/PlanarMidpoint/GeodesicBVP.lean @@ -0,0 +1,342 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.GeodesicFlow +public import LeanPool.PlanarMidpoint.GreenContinuous +public import LeanPool.PlanarMidpoint.GeodesicDefinitions +public import Mathlib.Topology.ContinuousMap.Compact +public import Mathlib.Topology.MetricSpace.Contracting +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity + +/-! +# Canonical short geodesics by a Dirichlet contraction + +A bounded Dirichlet Green operator and a sufficiently small local Lipschitz +constant produce a unique phase path in a closed ball about the constant +zero-velocity path. This supplies the local endpoint problem. +-/ + +@[expose] public section + +open Set Metric +open scoped NNReal + +namespace PlanarMidpoint + +noncomputable section + +section PathContraction + +variable {T V W : Type*} [TopologicalSpace T] [CompactSpace T] + [NormedAddCommGroup V] [NormedSpace ℝ V] [CompleteSpace V] + [NormedAddCommGroup W] [NormedSpace ℝ W] + +/-- Continuous paths restricted to one complete closed sup-norm ball. -/ +def BallPath (p : V) (r : ℝ) := closedBall (ContinuousMap.const T p) r + +omit [NormedSpace ℝ V] [CompleteSpace V] in +theorem path_mem_ball {p : V} {r : ℝ} (y : BallPath (T := T) p r) (t : T) : + y.1 t ∈ closedBall p r := by + exact (ContinuousMap.dist_apply_le_dist t).trans y.2 + +/-- Composition is continuous because the path stays in the region where +its vector field is Lipschitz. -/ +def composeBallPath {p : V} {r : ℝ} {F : V → W} {L : ℝ≥0} + (hF : LipschitzOnWith L F (closedBall p r)) (y : BallPath (T := T) p r) : C(T, W) := + ⟨F ∘ y.1, hF.continuousOn.comp_continuous y.1.continuous (path_mem_ball y)⟩ + +omit [NormedSpace ℝ W] [NormedSpace ℝ V] [CompleteSpace V] in +private theorem composeBallPath_dist {p : V} {r : ℝ} {F : V → W} {L : ℝ≥0} + (hF : LipschitzOnWith L F (closedBall p r)) (y z : BallPath (T := T) p r) : + dist (composeBallPath hF y) (composeBallPath hF z) ≤ L * dist y z := by + apply (ContinuousMap.dist_le (mul_nonneg L.coe_nonneg (dist_nonneg))).mpr + intro t + exact (hF.dist_le_mul (y.1 t) (path_mem_ball y t) (z.1 t) (path_mem_ball z t)).trans + (mul_le_mul_of_nonneg_left (ContinuousMap.dist_apply_le_dist t) L.coe_nonneg) + +omit [NormedSpace ℝ W] [NormedSpace ℝ V] [CompleteSpace V] in +private theorem composeBallPath_norm {p : V} {r : ℝ} (hr : 0 ≤ r) + {F : V → W} {L : ℝ≥0} (hF : LipschitzOnWith L F (closedBall p r)) (hFp : F p = 0) + (y : BallPath (T := T) p r) : ‖composeBallPath hF y‖ ≤ L * r := by + apply (ContinuousMap.norm_le _ (mul_nonneg L.coe_nonneg hr)).mpr + intro t + have h := hF.dist_le_mul (y.1 t) (path_mem_ball y t) p (mem_closedBall_self hr) + have h' : ‖F (y.1 t)‖ ≤ L * dist (y.1 t) p := by simpa [hFp] using h + exact h'.trans (mul_le_mul_of_nonneg_left (path_mem_ball y t) L.coe_nonneg) + +/-- Banach's theorem for the nonlinear Dirichlet equation in phase-path space. -/ +theorem exists_unique_green_path + (G : C(T, W) →L[ℝ] C(T, V)) (p : V) (r : ℝ) (hr : 0 ≤ r) + (F : V → W) (L : ℝ≥0) (hF : LipschitzOnWith L F (closedBall p r)) + (hFp : F p = 0) (hsmall : ‖G‖ * (L : ℝ) ≤ 1 / 2) + (a : C(T, V)) (ha : dist a (ContinuousMap.const T p) ≤ r / 2) : + ∃! y : BallPath (T := T) p r, y.1 = a + G (composeBallPath hF y) := by + have hmaps (y : BallPath (T := T) p r) : + a + G (composeBallPath hF y) ∈ closedBall (ContinuousMap.const T p) r := by + have hb := G.le_opNorm (composeBallPath hF y) + have hc := composeBallPath_norm hr hF hFp y + have hbound : ‖G (composeBallPath hF y)‖ ≤ r / 2 := by + calc + ‖G (composeBallPath hF y)‖ ≤ ‖G‖ * ‖composeBallPath hF y‖ := hb + _ ≤ ‖G‖ * (L * r) := mul_le_mul_of_nonneg_left hc (norm_nonneg G) + _ ≤ r / 2 := by nlinarith [mul_le_mul_of_nonneg_right hsmall hr] + calc + dist (a + G (composeBallPath hF y)) (ContinuousMap.const T p) + ≤ dist (a + G (composeBallPath hF y)) a + dist a (ContinuousMap.const T p) := + dist_triangle _ _ _ + _ = ‖G (composeBallPath hF y)‖ + dist a (ContinuousMap.const T p) := by simp + _ ≤ r := by linarith + let f : BallPath (T := T) p r → BallPath (T := T) p r := fun y => + ⟨a + G (composeBallPath hF y), hmaps y⟩ + have hf : ContractingWith (1 / 2 : ℝ≥0) f := by + refine ⟨by norm_num, LipschitzWith.of_dist_le_mul ?_⟩ + intro y z + change dist (a + G (composeBallPath hF y)) (a + G (composeBallPath hF z)) ≤ + ((1 / 2 : ℝ≥0) : ℝ) * dist y z + rw [dist_add_left] + calc + dist (G (composeBallPath hF y)) (G (composeBallPath hF z)) + ≤ ‖G‖ * dist (composeBallPath hF y) (composeBallPath hF z) := + G.lipschitzWith.dist_le_mul _ _ + _ ≤ ‖G‖ * (L * dist y z) := + mul_le_mul_of_nonneg_left (composeBallPath_dist hF y z) (norm_nonneg G) + _ ≤ ((1 / 2 : ℝ≥0) : ℝ) * dist y z := by + norm_num + nlinarith [mul_le_mul_of_nonneg_right hsmall (dist_nonneg (x := y) (y := z))] + let : Nonempty (BallPath (T := T) p r) := ⟨⟨ContinuousMap.const T p, mem_closedBall_self hr⟩⟩ + let : CompleteSpace (BallPath (T := T) p r) := isClosed_closedBall.completeSpace_coe + refine ⟨hf.fixedPoint f, ?_, ?_⟩ + · exact (congrArg Subtype.val hf.fixedPoint_isFixedPt).symm + · intro y hy + apply hf.fixedPoint_unique + apply Subtype.ext + exact hy.symm + +end PathContraction + +/-- The position and velocity of the affine chord joining two endpoints. -/ +def affinePhase (P Q : E) : PhasePath := + ⟨fun t => (P + (t : ℝ) • (Q - P), Q - P), by fun_prop⟩ + +theorem affinePhase_near (p P Q : E) {r : ℝ} (hr : 0 ≤ r) + (hP : dist P p ≤ r / 8) (hQ : dist Q p ≤ r / 8) : + dist (affinePhase P Q) (ContinuousMap.const UnitInterval (p, (0 : E))) ≤ r / 2 := by + have hd : ‖Q - P‖ ≤ r / 4 := by + calc + ‖Q - P‖ = dist Q P := (dist_eq_norm Q P).symm + _ ≤ dist Q p + dist p P := dist_triangle _ _ _ + _ ≤ r / 4 := by rw [dist_comm p P]; linarith + apply (ContinuousMap.dist_le (by positivity : 0 ≤ r / 2)).mpr + intro t + change max (dist (P + (t : ℝ) • (Q - P)) p) (dist (Q - P) 0) ≤ r / 2 + apply max_le + · calc + dist (P + (t : ℝ) • (Q - P)) p + ≤ dist (P + (t : ℝ) • (Q - P)) P + dist P p := dist_triangle _ _ _ + _ = (t : ℝ) * ‖Q - P‖ + dist P p := by + simp [norm_smul, abs_of_nonneg t.property.1] + _ ≤ r / 2 := by + have ht := mul_le_mul_of_nonneg_right t.property.2 (norm_nonneg (Q - P)) + nlinarith + · simpa using hd.trans (by linarith : r / 4 ≤ r / 2) + +/-- The affine endpoint chord plus the zero-endpoint Green correction. -/ +def bvpPosition (P Q : E) (a : AccelerationPath) (t : ℝ) : E := + P + t • (Q - P) + greenPosition a t + +/-- The endpoint secant plus the velocity of the Green correction. -/ +def bvpVelocity (P Q : E) (a : AccelerationPath) (t : ℝ) : E := + Q - P + greenVelocity a t + +@[simp] theorem bvpPosition_zero (P Q : E) (a : AccelerationPath) : + bvpPosition P Q a 0 = P := by simp [bvpPosition] + +@[simp] theorem bvpPosition_one (P Q : E) (a : AccelerationPath) : + bvpPosition P Q a 1 = Q := by simp [bvpPosition] + +theorem hasDerivAt_bvpPosition (P Q : E) (a : AccelerationPath) (t : ℝ) : + HasDerivAt (bvpPosition P Q a) (bvpVelocity P Q a t) t := by + unfold bvpPosition bvpVelocity + simpa only [id_eq, zero_add, one_smul] using + ((hasDerivAt_const t P).fun_add ((hasDerivAt_id t).smul_const (Q - P))).fun_add + (hasDerivAt_greenPosition a t) + +theorem hasDerivAt_bvpVelocity (P Q : E) (a : AccelerationPath) (t : ℝ) : + HasDerivAt (bvpVelocity P Q a) (pathExtend a t) t := by + unfold bvpVelocity + simpa only [zero_add] using + (hasDerivAt_const t (Q - P)).fun_add (hasDerivAt_greenVelocity a t) + +/-- A fixed phase path produces an actual geodesic with the prescribed endpoints. -/ +theorem fixed_green_isGeodesic (C : E → Coeff) (σ : ℝ) (p P Q : E) (r : ℝ) + {L : ℝ≥0} + (hF : LipschitzOnWith L (fun z : Phase => -σ • K (C z.1) z.2 z.2) + (closedBall (p, (0 : E)) r)) + (y : BallPath (T := UnitInterval) (p, (0 : E)) r) + (hy : y.1 = affinePhase P Q + greenOperator (composeBallPath hF y)) : + IsGeodesicSegment C σ (bvpPosition P Q (composeBallPath hF y)) + (bvpVelocity P Q (composeBallPath hF y)) ∧ + ∀ t (ht : t ∈ UnitInterval), + (bvpPosition P Q (composeBallPath hF y) t, + bvpVelocity P Q (composeBallPath hF y) t) = y.1 ⟨t, ht⟩ := by + have hpath (t : ℝ) (ht : t ∈ UnitInterval) : + (bvpPosition P Q (composeBallPath hF y) t, + bvpVelocity P Q (composeBallPath hF y) t) = y.1 ⟨t, ht⟩ := by + simpa [affinePhase, bvpPosition, bvpVelocity, greenOperator_apply] using + (congrArg (fun z : PhasePath => z ⟨t, ht⟩) hy).symm + refine ⟨⟨fun t _ => hasDerivAt_bvpPosition P Q _ t, ?_⟩, hpath⟩ + intro t ht + have hacc : pathExtend (composeBallPath hF y) t = + -σ • K (C (bvpPosition P Q (composeBallPath hF y) t)) + (bvpVelocity P Q (composeBallPath hF y) t) + (bvpVelocity P Q (composeBallPath hF y) t) := by + rw [pathExtend_mem _ t ht] + change - σ • K (C (y.1 ⟨t, ht⟩).1) (y.1 ⟨t, ht⟩).2 (y.1 ⟨t, ht⟩).2 = _ + rw [← hpath t ht] + simpa only [hacc] using hasDerivAt_bvpVelocity P Q (composeBallPath hF y) t + +/-- The phase path of an actual geodesic, restricted to the parameter interval. -/ +def segmentPhasePath {C : E → Coeff} {σ : ℝ} {γ v : ℝ → E} + (hg : IsGeodesicSegment C σ γ v) : PhasePath := + ⟨fun t => (γ t, v t), + (continuousOn_iff_continuous_domRestrict.mp + (show ContinuousOn γ UnitInterval from fun t ht => (hg.1 t + ht).continuousAt.continuousWithinAt)).prodMk + (continuousOn_iff_continuous_domRestrict.mp + (show ContinuousOn v UnitInterval from fun t ht => (hg.2 t + ht).continuousAt.continuousWithinAt))⟩ + +theorem short_path_mem {C : E → Coeff} {σ : ℝ} {p P Q : E} {r : ℝ} + (hr : 0 ≤ r) {γ v : ℝ → E} (h : IsShortGeodesic C σ p r P Q γ v) : + segmentPhasePath h.1 ∈ closedBall (ContinuousMap.const UnitInterval (p, (0 : E))) r := by + apply (ContinuousMap.dist_le hr).mpr + intro t + change max (dist (γ t) p) (dist (v t) 0) ≤ r + apply max_le + · simpa only [dist_eq_norm] using (h.2.2.2 t t.property).1.le + · simpa using (h.2.2.2 t t.property).2.le + +/-- Every actual short geodesic satisfies the same Green fixed-point equation. -/ +theorem actual_geodesic_is_fixed {C : E → Coeff} {σ : ℝ} {p P Q : E} {r : ℝ} + (hr : 0 ≤ r) {L : ℝ≥0} + (hF : LipschitzOnWith L (fun z : Phase => -σ • K (C z.1) z.2 z.2) + (closedBall (p, (0 : E)) r)) + {γ v : ℝ → E} (h : IsShortGeodesic C σ p r P Q γ v) : + let y : BallPath (T := UnitInterval) (p, (0 : E)) r := + ⟨segmentPhasePath h.1, short_path_mem hr h⟩ + y.1 = affinePhase P Q + greenOperator (composeBallPath hF y) := by + let y : BallPath (T := UnitInterval) (p, (0 : E)) r := + ⟨segmentPhasePath h.1, short_path_mem hr h⟩ + let a := composeBallPath hF y + let xdiff := fun t => γ t - bvpPosition P Q a t + let vdiff := fun t => v t - bvpVelocity P Q a t + have hx (t : ℝ) (ht : t ∈ UnitInterval) : HasDerivAt xdiff (vdiff t) t := + (h.1.1 t ht).fun_sub (hasDerivAt_bvpPosition P Q a t) + have hv (t : ℝ) (ht : t ∈ UnitInterval) : HasDerivAt vdiff 0 t := by + have he : pathExtend a t = -σ • K (C (γ t)) (v t) (v t) := by + rw [pathExtend_mem a t ht] + rfl + simpa only [he, sub_self, vdiff, Pi.sub_apply] using (h.1.2 t ht).fun_sub + (hasDerivAt_bvpVelocity P Q a t) + have h0 : xdiff 0 = 0 := by simp [xdiff, h.2.1] + have h1 : xdiff 1 = 0 := by simp [xdiff, h.2.2.1] + have hpos (t : ℝ) (ht : t ∈ UnitInterval) : γ t = bvpPosition P Q a t := by + exact sub_eq_zero.mp (dirichlet_unique xdiff vdiff hx hv h0 h1 t ht) + have hvel (t : ℝ) (ht : t ∈ UnitInterval) : v t = bvpVelocity P Q a t := by + have hb := dirichlet_velocity_bound xdiff vdiff (fun _ => (0 : E)) 0 + hx hv (by simp) h0 h1 t ht + exact sub_eq_zero.mp (norm_eq_zero.mp (le_antisymm hb (norm_nonneg _))) + change y.1 = _ + ext t : 1 + apply Prod.ext + · change γ t = bvpPosition P Q a t + exact hpos t t.property + · change v t = bvpVelocity P Q a t + exact hvel t t.property + +/-- Every sufficiently close pair of endpoints has a unique short geodesic. +The permitted phase radius can be chosen below any prescribed positive size. -/ +theorem exists_unique_short_geodesic {C : E → Coeff} {p : E} + (hC : ContDiffAt ℝ 1 C p) (σ : ℝ) (η : ℝ) (hη : 0 < η) : + ∃ r > (0 : ℝ), r ≤ η ∧ ∃ δ > (0 : ℝ), ∀ P Q, + P ∈ ball p δ → Q ∈ ball p δ → ∃ γ v, + IsShortGeodesic C σ p r P Q γ v ∧ + ∀ γ' v', IsShortGeodesic C σ p r P Q γ' v' → + ∀ t ∈ UnitInterval, γ' t = γ t ∧ v' t = v t := by + let F : Phase → E := fun z => -σ • K (C z.1) z.2 z.2 + have hFp : F (p, 0) = 0 := by apply vec_ext <;> simp [F, K] + obtain ⟨S, hS, hLip⟩ := (hasStrictFDerivAt_acceleration_zero hC + σ).exists_lipschitzOnWith_of_nnnorm_lt (1 / 4 : ℝ≥0) (by norm_num) + obtain ⟨ε, hε, hεS⟩ := Metric.mem_nhds_iff.mp hS + let r := min (ε / 2) η + have hr : 0 < r := lt_min (by positivity) hη + have hrε : r < ε := lt_of_le_of_lt (min_le_left _ _) (by linarith) + have hrη : r ≤ η := min_le_right _ _ + have hFr : LipschitzOnWith (1 / 4 : ℝ≥0) F (closedBall (p, (0 : E)) r) := + hLip.mono (fun z hz => hεS (lt_of_le_of_lt hz hrε)) + refine ⟨r, hr, hrη, r / 16, by positivity, ?_⟩ + intro P Q hP hQ + have ha : dist (affinePhase P Q) (ContinuousMap.const UnitInterval (p, (0 : E))) ≤ r / 4 := by + have h := affinePhase_near p P Q (r := r / 2) (by positivity) + (by change dist P p < r / 16 at hP; linarith) + (by change dist Q p < r / 16 at hQ; linarith) + linarith + have hsmall : ‖greenOperator‖ * ((1 / 4 : ℝ≥0) : ℝ) ≤ 1 / 2 := by + norm_num + nlinarith [norm_greenOperator_le] + obtain ⟨y, hy, huniq⟩ := exists_unique_green_path greenOperator (p, (0 : E)) r hr.le + F (1 / 4) hFr hFp hsmall (affinePhase P Q) (ha.trans (by linarith)) + let a := composeBallPath hFr y + let γ := bvpPosition P Q a + let v := bvpVelocity P Q a + obtain ⟨hgeom, hpath⟩ := fixed_green_isGeodesic C σ p P Q r hFr y hy + have hGbound : ‖greenOperator a‖ ≤ r / 4 := by + have hn := composeBallPath_norm hr.le hFr hFp y + have hg := norm_greenPath_le a + change ‖greenPath a‖ ≤ r / 4 + norm_num at hn + exact hg.trans (by simpa [a, div_eq_mul_inv, mul_comm] using hn) + have hnear : dist y.1 (ContinuousMap.const UnitInterval (p, (0 : E))) ≤ r / 2 := by + rw [hy] + calc + dist (affinePhase P Q + greenOperator a) (ContinuousMap.const UnitInterval (p, (0 : E))) + ≤ dist (affinePhase P Q + greenOperator a) (affinePhase P Q) + dist (affinePhase P Q) + (ContinuousMap.const UnitInterval (p, (0 : E))) := dist_triangle _ _ _ + _ = ‖greenOperator a‖ + dist (affinePhase P Q) (ContinuousMap.const UnitInterval (p, (0 : + E))) := by simp + _ ≤ r / 2 := by linarith + have hshort : IsShortGeodesic C σ p r P Q γ v := by + refine ⟨hgeom, bvpPosition_zero P Q a, bvpPosition_one P Q a, ?_⟩ + intro t ht + have hb := (ContinuousMap.dist_apply_le_dist (f := y.1) + (g := ContinuousMap.const UnitInterval (p, (0 : E))) ⟨t, ht⟩).trans hnear + rw [← hpath t ht] at hb + change max (dist (γ t) p) (dist (v t) 0) ≤ r / 2 at hb + have hb1 := (max_le_iff.mp hb).1 + have hb2 := (max_le_iff.mp hb).2 + constructor + · rw [dist_eq_norm] at hb1 + linarith + · rw [dist_zero_right] at hb2 + linarith + refine ⟨γ, v, hshort, ?_⟩ + intro γ' v' hg' t ht + let y' : BallPath (T := UnitInterval) (p, (0 : E)) r := + ⟨segmentPhasePath hg'.1, short_path_mem hr.le hg'⟩ + have hfix : y'.1 = affinePhase P Q + greenOperator (composeBallPath hFr y') := + actual_geodesic_is_fixed hr.le hFr hg' + have he : y' = y := huniq y' hfix + have heval := congrArg (fun z : BallPath (T := UnitInterval) (p, (0 : E)) r => z.1 ⟨t, ht⟩) he + change (γ' t, v' t) = y.1 ⟨t, ht⟩ at heval + rw [← hpath t ht] at heval + exact ⟨congrArg Prod.fst heval, congrArg Prod.snd heval⟩ + +end +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GeodesicDefinitions.lean b/LeanPool/PlanarMidpoint/GeodesicDefinitions.lean new file mode 100644 index 0000000000..6481513dba --- /dev/null +++ b/LeanPool/PlanarMidpoint/GeodesicDefinitions.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Analysis.Calculus.Deriv.Basic + + +/-! +# Local affine-parameter geodesic midpoints + +The definition uses actual position and velocity curves satisfying the +geodesic equation. Uniqueness is only asserted on the parameter interval +and among short curves in the specified neighborhood. There is no +regularity assumption on the dependence of the curves on their endpoints. +-/ + +@[expose] public section + +open Set Metric + +namespace PlanarMidpoint + +/-- Position and velocity curves satisfying the affine geodesic ODE on `[0, 1]`. -/ +def IsGeodesicSegment (C : E → Coeff) (σ : ℝ) (γ v : ℝ → E) : Prop := + (∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt γ (v t) t) ∧ + (∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (-σ • K (C (γ t)) (v t) (v t)) t) + +/-- A geodesic with prescribed endpoints and small position and velocity. -/ +def IsShortGeodesic (C : E → Coeff) (σ : ℝ) (p : E) (r : ℝ) + (P Q : E) (γ v : ℝ → E) : Prop := + IsGeodesicSegment C σ γ v ∧ γ 0 = P ∧ γ 1 = Q ∧ + ∀ t ∈ Icc (0 : ℝ) 1, ‖γ t - p‖ < r ∧ ‖v t‖ < r + +/-- A midpoint map supplied by the unique short geodesic near a diagonal point. -/ +def IsCanonicalLocalMidpoint (Ω : Set E) (C : E → Coeff) (σ : ℝ) + (p : E) (r : ℝ) (W : Set (E × E)) (A : E → E → E) : Prop := + 0 < r ∧ ball p r ⊆ Ω ∧ IsOpen W ∧ (p, p) ∈ W ∧ + ∀ P Q, (P, Q) ∈ W → ∃ γ v, + IsShortGeodesic C σ p r P Q γ v ∧ A P Q = γ midpointTime ∧ + ∀ γ' v', IsShortGeodesic C σ p r P Q γ' v' → + ∀ t ∈ Icc (0 : ℝ) 1, γ' t = γ t ∧ v' t = v t + +/-- Complementarity of the canonical local midpoint maps of `D+K` and `D-K` +near every diagonal point. The definition exposes the actual geodesic ODE. -/ +def LocalMidpointInvariance (Ω : Set E) (C : E → Coeff) : Prop := + ∀ p ∈ Ω, ∃ rPlus rMinus W APlus AMinus, + IsCanonicalLocalMidpoint Ω C 1 p rPlus W APlus ∧ + IsCanonicalLocalMidpoint Ω C (-1) p rMinus W AMinus ∧ + ∀ P Q, (P, Q) ∈ W → APlus P Q + AMinus P Q = P + Q + +/-- A formulation with arbitrarily small short curves, used only as an +intermediate consequence of canonical midpoint invariance. -/ +def ArbitrarilyShortComplementaryPairs (C : E → Coeff) (p : E) : Prop := + ∀ r > (0 : ℝ), ∃ δ > (0 : ℝ), ∀ P Q, + P ∈ ball p δ → Q ∈ ball p δ → ∃ γPlus vPlus γMinus vMinus, + IsShortGeodesic C 1 p r P Q γPlus vPlus ∧ + IsShortGeodesic C (-1) p r P Q γMinus vMinus ∧ + γPlus (1 / 2) + γMinus (1 / 2) = P + Q + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GeodesicEstimate.lean b/LeanPool/PlanarMidpoint/GeodesicEstimate.lean new file mode 100644 index 0000000000..47488531b9 --- /dev/null +++ b/LeanPool/PlanarMidpoint/GeodesicEstimate.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.TensorBounds +public import LeanPool.PlanarMidpoint.BVPStability +public import Mathlib.Tactic.GCongr +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Ring + +/-! +# Quantitative comparison of geodesics and polynomial trajectories + +These estimates preserve the quadratic dependence of acceleration on velocity. +The contraction constants tend to zero with the allowed velocity radius. +-/ + +@[expose] public section + +namespace PlanarMidpoint +open Set + +/-- Spatial and velocity Lipschitz constants for the Christoffel force on a +small phase neighborhood. -/ +theorem force_difference_bound (C : E → Coeff) (S : Set E) (M L r : ℝ) + (hM : 0 ≤ M) (hL : 0 ≤ L) (_hr : 0 ≤ r) + (hbound : ∀ x ∈ S, ‖C x‖ ≤ M) + (hLip : ∀ x ∈ S, ∀ y ∈ S, ‖C x - C y‖ ≤ L * ‖x - y‖) + {x y v w : E} (hx : x ∈ S) (hy : y ∈ S) (hv : ‖v‖ ≤ r) (hw : ‖w‖ ≤ r) : + ‖K (C x) v v - K (C y) w w‖ ≤ + (8 * L * r ^ 2) * ‖x - y‖ + (16 * M * r) * ‖v - w‖ := by + calc + ‖K (C x) v v - K (C y) w w‖ ≤ + 8 * ‖C x - C y‖ * ‖v‖ ^ 2 + 8 * ‖C y‖ * (‖v‖ + ‖w‖) * ‖v - w‖ := + norm_K_diagonal_sub_le _ _ _ _ + _ ≤ 8 * (L * ‖x - y‖) * r ^ 2 + 8 * M * (r + r) * ‖v - w‖ := by + gcongr + · exact hLip x hx y hy + · exact hbound y hy + _ = _ := by ring + +/-- A true geodesic and a polynomial trajectory with the same endpoints are +close whenever the latter has a small acceleration residual. -/ +theorem geodesic_polynomial_comparison + (C : E → Coeff) (S : Set E) (M L r R : ℝ) + (hM : 0 ≤ M) (hL : 0 ≤ L) (hr : 0 ≤ r) + (hbound : ∀ x ∈ S, ‖C x‖ ≤ M) + (hLip : ∀ x ∈ S, ∀ y ∈ S, ‖C x - C y‖ ≤ L * ‖x - y‖) + (hsmall : 8 * L * r ^ 2 + 16 * M * r < 1) + (x v y w b : ℝ → E) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, + HasDerivAt v (-K (C (x t)) (v t) (v t)) t) + (hy : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt y (w t) t) + (hw : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt w (b t) t) + (h0 : x 0 = y 0) (h1 : x 1 = y 1) + (hxS : ∀ t ∈ Icc (0 : ℝ) 1, x t ∈ S) + (hyS : ∀ t ∈ Icc (0 : ℝ) 1, y t ∈ S) + (hvsmall : ∀ t ∈ Icc (0 : ℝ) 1, ‖v t‖ ≤ r) + (hwsmall : ∀ t ∈ Icc (0 : ℝ) 1, ‖w t‖ ≤ r) + (hres : ∀ t ∈ Icc (0 : ℝ) 1, ‖b t + K (C (y t)) (w t) (w t)‖ ≤ R) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖x t - y t‖ ≤ R / (1 - 8 * L * r ^ 2 - 16 * M * r) ∧ + ‖v t - w t‖ ≤ R / (1 - 8 * L * r ^ 2 - 16 * M * r) := by + apply bvp_stability x v (fun s ↦ -K (C (x s)) (v s) (v s)) y w b + R (8 * L * r ^ 2) (16 * M * r) hx hv hy hw h0 h1 + (by positivity) (by positivity) hsmall _ t ht + intro s hs + have hforce := force_difference_bound C S M L r hM hL hr hbound hLip + (hxS s hs) (hyS s hs) (hvsmall s hs) (hwsmall s hs) + calc + ‖ - K (C (x s)) (v s) (v s) - b s‖ = + ‖ - (K (C (x s)) (v s) (v s) - K (C (y s)) (w s) (w s)) - (b s + K (C (y s)) (w s) (w s))‖ + := by congr 1; module + _ ≤ ‖K (C (x s)) (v s) (v s) - K (C (y s)) (w s) (w s)‖ + ‖b s + K (C (y s)) (w s) (w s)‖ := by + simpa only [norm_neg] using norm_sub_le + (-(K (C (x s)) (v s) (v s) - K (C (y s)) (w s) (w s))) + (b s + K (C (y s)) (w s) (w s)) + _ ≤ R + (8 * L * r ^ 2) * ‖x s - y s‖ + (16 * M * r) * ‖v s - w s‖ := by + linarith [hres s hs] + +/-- A coefficient Taylor error, quadratic in displacement, becomes a fourth-order +force error when displacement and velocity are both first order. -/ +theorem force_taylor_error_bound (c d : Coeff) (x v : E) (η B ε : ℝ) + (hη : 0 ≤ η) (hB : 0 ≤ B) (hε : 0 ≤ ε) + (hcoeff : ‖c - d‖ ≤ η * ‖x‖ ^ 2) + (hx : ‖x‖ ≤ B * ε) (hv : ‖v‖ ≤ B * ε) : + ‖K c v v - K d v v‖ ≤ 8 * η * B ^ 4 * ε ^ 4 := by + have he : K c v v - K d v v = K (c - d) v v := by + apply vec_ext <;> simp [K] <;> ring + rw [he] + calc + ‖K (c - d) v v‖ ≤ 8 * ‖c - d‖ * ‖v‖ * ‖v‖ := norm_K_le _ _ _ + _ ≤ 8 * (η * (B * ε) ^ 2) * (B * ε) * (B * ε) := by + gcongr + exact hcoeff.trans (by gcongr) + _ = _ := by ring + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GeodesicFlow.lean b/LeanPool/PlanarMidpoint/GeodesicFlow.lean new file mode 100644 index 0000000000..26229135d9 --- /dev/null +++ b/LeanPool/PlanarMidpoint/GeodesicFlow.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Analysis.Calculus.ContDiff.WithLp +public import Mathlib.Analysis.Calculus.FDeriv.WithLp +public import Mathlib.Analysis.Calculus.FDeriv.Mul +public import Mathlib.Analysis.ODE.ExistUnique +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Ring + +/-! +# Geodesic phase equation + +A geodesic for the connection `D + σ K` is an integral curve of the phase +field `(x,v) ↦ (v, -σ K_x(v,v))`. This file proves local initial-value +existence from smooth coefficients. It does not assume parameter regularity. +-/ + +@[expose] public section + +open Set Filter +open scoped Topology ContDiff + +namespace PlanarMidpoint + +/-- Position and velocity in the product normed phase space. -/ +abbrev Phase := E × E + +/-- The acceleration field of the affine geodesic equation. -/ +def phaseField (C : E → Coeff) (σ : ℝ) (z : Phase) : Phase := + (z.2, -σ • K (C z.1) z.2 z.2) + +theorem contDiffAt_K {A : Type*} [NormedAddCommGroup A] [NormedSpace ℝ A] + {n : ℕ∞ω} {c : A → Coeff} {u v : A → E} {x : A} + (hc : ContDiffAt ℝ n c x) (hu : ContDiffAt ℝ n u x) (hv : ContDiffAt ℝ n v x) : + ContDiffAt ℝ n (fun y ↦ K (c y) (u y) (v y)) x := by + apply (contDiffAt_piLp 2).2 + intro i + fin_cases i <;> dsimp [K, vec] + all_goals + have hci (j : Fin 4) := (contDiffAt_pi.mp hc) j + have hui (j : Fin 2) := (contDiffAt_piLp 2).mp hu j + have hvi (j : Fin 2) := (contDiffAt_piLp 2).mp hv j + fun_prop + +theorem contDiffAt_phaseField {C : E → Coeff} {p : E} {v : E} {n : ℕ∞ω} + (hC : ContDiffAt ℝ n C p) (σ : ℝ) : + ContDiffAt ℝ n (phaseField C σ) (p, v) := by + exact contDiffAt_snd.prodMk ((contDiffAt_K + (hC.comp (p, v) contDiffAt_fst) contDiffAt_snd contDiffAt_snd).const_smul (-σ)) + +theorem exists_local_geodesic {C : E → Coeff} {p v : E} + (hC : ContDiffAt ℝ 1 C p) (σ t₀ : ℝ) : + ∃ z : ℝ → Phase, z t₀ = (p, v) ∧ ∃ ε > (0 : ℝ), + ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), + HasDerivAt z (phaseField C σ (z t)) t := by + exact (contDiffAt_phaseField hC + σ).exists_forall_mem_closedBall_exists_eq_forall_mem_Ioo_hasDerivAt₀ t₀ + +theorem geodesic_components {C : E → Coeff} {σ : ℝ} {z : ℝ → Phase} {t : ℝ} + (hz : HasDerivAt z (phaseField C σ (z t)) t) : + HasDerivAt (fun s ↦ (z s).1) (z t).2 t ∧ + HasDerivAt (fun s ↦ (z s).2) (-σ • K (C (z t).1) (z t).2 (z t).2) t := by + exact ⟨hz.fst, hz.snd⟩ + +/-- Two actual geodesics with the same initial phase have the same local germ. -/ +theorem local_geodesic_unique {C : E → Coeff} {p v : E} {σ t₀ : ℝ} + (hC : ContDiffAt ℝ 1 C p) {z w : ℝ → Phase} + (hz₀ : z t₀ = (p, v)) (hw₀ : w t₀ = (p, v)) + (hz : ∀ᶠ t in 𝓝 t₀, HasDerivAt z (phaseField C σ (z t)) t) + (hw : ∀ᶠ t in 𝓝 t₀, HasDerivAt w (phaseField C σ (w t)) t) : + z =ᶠ[𝓝 t₀] w := by + obtain ⟨L, S, hS, hLip⟩ := (contDiffAt_phaseField (v := v) hC σ).exists_lipschitzOnWith + have hzc : ContinuousAt z t₀ := (hz.self_of_nhds).continuousAt + have hwc : ContinuousAt w t₀ := (hw.self_of_nhds).continuousAt + have hzS : ∀ᶠ t in 𝓝 t₀, z t ∈ S := hzc (hz₀ ▸ hS) + have hwS : ∀ᶠ t in 𝓝 t₀, w t ∈ S := hwc (hw₀ ▸ hS) + exact ODE_solution_unique_of_eventually + (v := fun _ ↦ phaseField C σ) (s := fun _ ↦ S) + (Filter.Eventually.of_forall fun _ ↦ hLip) (hz.and hzS) (hw.and hwS) + (hz₀.trans hw₀.symm) + +@[simp] theorem phaseField_zero (C : E → Coeff) (σ : ℝ) (p : E) : + phaseField C σ (p, 0) = 0 := by + apply Prod.ext + · rfl + · apply vec_ext <;> simp [phaseField, K] + +/-- The constant curve is the geodesic with zero initial velocity. -/ +theorem constant_geodesic (C : E → Coeff) (σ : ℝ) (p : E) (t : ℝ) : + HasDerivAt (fun _ : ℝ ↦ (p, (0 : E))) + (phaseField C σ (p, 0)) t := by + simpa only [phaseField_zero] using hasDerivAt_const t (p, (0 : E)) + +/-- The acceleration has zero strict derivative at every zero-velocity phase. +Consequently its local Lipschitz constant can be made arbitrarily small. -/ +theorem hasStrictFDerivAt_acceleration_zero {C : E → Coeff} {p : E} + (hC : ContDiffAt ℝ 1 C p) (σ : ℝ) : + HasStrictFDerivAt (𝕜 := ℝ) (fun z : Phase ↦ -σ • K (C z.1) z.2 z.2) 0 (p, 0) := by + have hc (i : Fin 4) := (hasStrictFDerivAt_apply (𝕜 := ℝ) i (C p)).comp (p, (0 : E)) + ((hC.hasStrictFDerivAt one_ne_zero).comp (p, (0 : E)) (hasStrictFDerivAt_fst (𝕜 := ℝ) (p := + (p, (0 : E))))) + have hu (j : Fin 2) := (PiLp.hasStrictFDerivAt_apply (𝕜 := ℝ) 2 (0 : E) j).comp + (p, (0 : E)) (hasStrictFDerivAt_snd (𝕜 := ℝ) (p := (p, (0 : E)))) + have hterm (i : Fin 4) (j k : Fin 2) : + HasStrictFDerivAt (𝕜 := ℝ) (fun z : Phase ↦ C z.1 i * z.2 j * z.2 k) 0 (p, 0) := by + convert ((hc i).mul (hu j)).mul (hu k) using 1; simp + have hk : HasStrictFDerivAt (𝕜 := ℝ) (fun z : Phase ↦ K (C z.1) z.2 z.2) 0 (p, 0) := by + apply (hasStrictFDerivAt_piLp 2).2 + intro i + fin_cases i + · convert (((hterm 0 0 0).add (hterm 1 0 1)).add + (hterm 1 1 0)).add (hterm 2 1 1) using 1 + · ext z + simp [K] + ring + · simp + · convert (((hterm 1 0 0).add (hterm 2 0 1)).add + (hterm 2 1 0)).add (hterm 3 1 1) using 1 + · ext z + simp [K] + ring + · simp + convert hk.const_smul (-σ) using 1; simp + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GreenContinuous.lean b/LeanPool/PlanarMidpoint/GreenContinuous.lean new file mode 100644 index 0000000000..fe43e68b51 --- /dev/null +++ b/LeanPool/PlanarMidpoint/GreenContinuous.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import LeanPool.PlanarMidpoint.GreenOperator +public import Mathlib.Topology.ContinuousMap.Compact +public import Mathlib.Topology.Order.ProjIcc +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum + +/-! The Dirichlet solution operator on continuous acceleration paths. -/ + +@[expose] public section + +open Set MeasureTheory + +noncomputable section + +namespace PlanarMidpoint + +/-- The compact real parameter interval `[0, 1]`. -/ +abbrev UnitInterval := Icc (0 : ℝ) 1 +/-- Continuous planar acceleration paths on the unit interval. -/ +abbrev AccelerationPath := C(UnitInterval, E) +/-- Continuous position-velocity paths on the unit interval. -/ +abbrev PhasePath := C(UnitInterval, E × E) + +/-- Extension of an acceleration path by clamping the parameter to the unit interval. -/ +def pathExtend (f : AccelerationPath) (t : ℝ) : E := + f (projIcc 0 1 (by norm_num) t) + +theorem continuous_pathExtend (f : AccelerationPath) : Continuous (pathExtend f) := + f.continuous.comp continuous_projIcc + +theorem pathExtend_mem (f : AccelerationPath) (t : ℝ) (ht : t ∈ UnitInterval) : + pathExtend f t = f ⟨t, ht⟩ := by simp [pathExtend, projIcc_of_mem, ht] + +/-- The integral of an extended acceleration path from zero to the given time. -/ +def pathPrimitive (f : AccelerationPath) (t : ℝ) : E := ∫ s in (0 : ℝ)..t, pathExtend f s + +theorem hasDerivAt_pathPrimitive (f : AccelerationPath) (t : ℝ) : + HasDerivAt (pathPrimitive f) (pathExtend f t) t := by + exact intervalIntegral.integral_hasDerivAt_right + ((continuous_pathExtend f).intervalIntegrable _ _) + (continuous_pathExtend f).aestronglyMeasurable.stronglyMeasurableAtFilter + (continuous_pathExtend f).continuousAt + +theorem continuous_pathPrimitive (f : AccelerationPath) : Continuous (pathPrimitive f) := + continuous_iff_continuousAt.mpr fun t => (hasDerivAt_pathPrimitive f t).continuousAt + +/-- The second primitive of an extended acceleration path. -/ +def pathSecondPrimitive (f : AccelerationPath) (t : ℝ) : E := + ∫ s in (0 : ℝ)..t, pathPrimitive f s + +theorem hasDerivAt_pathSecondPrimitive (f : AccelerationPath) (t : ℝ) : + HasDerivAt (pathSecondPrimitive f) (pathPrimitive f t) t := by + exact intervalIntegral.integral_hasDerivAt_right + ((continuous_pathPrimitive f).intervalIntegrable _ _) + (continuous_pathPrimitive f).aestronglyMeasurable.stronglyMeasurableAtFilter + (continuous_pathPrimitive f).continuousAt + +/-- The second primitive with its endpoint chord removed. -/ +def greenPosition (f : AccelerationPath) (t : ℝ) : E := + pathSecondPrimitive f t - t • pathSecondPrimitive f 1 + +/-- The first primitive minus the endpoint correction. -/ +def greenVelocity (f : AccelerationPath) (t : ℝ) : E := + pathPrimitive f t - pathSecondPrimitive f 1 + +theorem hasDerivAt_greenPosition (f : AccelerationPath) (t : ℝ) : + HasDerivAt (greenPosition f) (greenVelocity f t) t := by + convert! (hasDerivAt_pathSecondPrimitive f t).fun_sub + ((hasDerivAt_id t).smul_const (pathSecondPrimitive f 1)) using 1 + simp [greenVelocity] + +theorem hasDerivAt_greenVelocity (f : AccelerationPath) (t : ℝ) : + HasDerivAt (greenVelocity f) (pathExtend f t) t := + (hasDerivAt_pathPrimitive f t).sub_const _ + +@[simp] theorem greenPosition_zero (f : AccelerationPath) : greenPosition f 0 = 0 := by + simp [greenPosition, pathSecondPrimitive] + +@[simp] theorem greenPosition_one (f : AccelerationPath) : greenPosition f 1 = 0 := by + simp [greenPosition] + +/-- The position-velocity path solving the zero-endpoint Dirichlet problem. -/ +def greenPath (f : AccelerationPath) : PhasePath := + ⟨fun t => (greenPosition f t, greenVelocity f t), + ((continuous_iff_continuousAt.mpr fun t => (hasDerivAt_greenPosition f t).continuousAt).prodMk + (continuous_iff_continuousAt.mpr fun t => (hasDerivAt_greenVelocity f t).continuousAt)).comp + continuous_subtype_val⟩ + +theorem norm_greenPath_le (f : AccelerationPath) : ‖greenPath f‖ ≤ ‖f‖ := by + apply (ContinuousMap.norm_le _ (norm_nonneg _)).mpr + intro t + change max ‖greenPosition f t‖ ‖greenVelocity f t‖ ≤ ‖f‖ + apply max_le + · exact dirichlet_position_bound (greenPosition f) (greenVelocity f) (pathExtend f) ‖f‖ + (fun t _ => hasDerivAt_greenPosition f t) (fun t _ => hasDerivAt_greenVelocity f t) + (fun t ht => by rw [pathExtend_mem f t ht]; exact f.norm_coe_le_norm _) + (greenPosition_zero f) (greenPosition_one f) t t.property + · exact dirichlet_velocity_bound (greenPosition f) (greenVelocity f) (pathExtend f) ‖f‖ + (fun t _ => hasDerivAt_greenPosition f t) (fun t _ => hasDerivAt_greenVelocity f t) + (fun t ht => by rw [pathExtend_mem f t ht]; exact f.norm_coe_le_norm _) + (greenPosition_zero f) (greenPosition_one f) t t.property + +theorem pathPrimitive_add (f g : AccelerationPath) (t : ℝ) : + pathPrimitive (f + g) t = pathPrimitive f t + pathPrimitive g t := by + exact intervalIntegral.integral_add + ((continuous_pathExtend f).intervalIntegrable _ _) ((continuous_pathExtend + g).intervalIntegrable _ _) + +theorem pathPrimitive_smul (r : ℝ) (f : AccelerationPath) (t : ℝ) : + pathPrimitive (r • f) t = r • pathPrimitive f t := by + exact intervalIntegral.integral_smul r _ + +theorem pathSecondPrimitive_add (f g : AccelerationPath) (t : ℝ) : + pathSecondPrimitive (f + g) t = pathSecondPrimitive f t + pathSecondPrimitive g t := by + simp only [pathSecondPrimitive, pathPrimitive_add] + exact intervalIntegral.integral_add + ((continuous_pathPrimitive f).intervalIntegrable _ _) ((continuous_pathPrimitive + g).intervalIntegrable _ _) + +theorem pathSecondPrimitive_smul (r : ℝ) (f : AccelerationPath) (t : ℝ) : + pathSecondPrimitive (r • f) t = r • pathSecondPrimitive f t := by + simp only [pathSecondPrimitive, pathPrimitive_smul, intervalIntegral.integral_smul] + +/-- Linearity of the Dirichlet Green construction on continuous acceleration paths. -/ +def greenLinear : AccelerationPath →ₗ[ℝ] PhasePath where + toFun := greenPath + map_add' f g := by + ext t : 1 + apply Prod.ext <;> simp [greenPath, greenPosition, greenVelocity, + pathPrimitive_add, pathSecondPrimitive_add] <;> module + map_smul' r f := by + ext t : 1 + apply Prod.ext <;> simp [greenPath, greenPosition, greenVelocity, + pathPrimitive_smul, pathSecondPrimitive_smul] <;> module + +/-- The bounded Dirichlet Green operator, with operator norm at most one. -/ +def greenOperator : AccelerationPath →L[ℝ] PhasePath := + greenLinear.mkContinuous 1 (fun f => by + change ‖greenPath f‖ ≤ 1 * ‖f‖ + simpa using norm_greenPath_le f) + +@[simp] theorem greenOperator_apply (f : AccelerationPath) (t : UnitInterval) : + greenOperator f t = (greenPosition f t, greenVelocity f t) := rfl + +theorem norm_greenOperator_le : ‖greenOperator‖ ≤ 1 := by + apply ContinuousLinearMap.opNorm_le_bound _ (by norm_num) + intro f + change ‖greenPath f‖ ≤ 1 * ‖f‖ + simpa using norm_greenPath_le f + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/GreenOperator.lean b/LeanPool/PlanarMidpoint/GreenOperator.lean new file mode 100644 index 0000000000..69f80ef7de --- /dev/null +++ b/LeanPool/PlanarMidpoint/GreenOperator.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import Mathlib.Analysis.Calculus.MeanValue +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum + +/-! Coarse Dirichlet estimates for vector-valued curves on the unit interval. -/ + +@[expose] public section +namespace PlanarMidpoint + +open Set MeasureTheory +open scoped Interval + +variable {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] [CompleteSpace V] + +/-- Bounded acceleration controls velocity relative to its endpoint secant. -/ +theorem velocity_secant_bound (x v a : ℝ → V) (M : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (ha : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t‖ ≤ M) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖v t - (x 1 - x 0)‖ ≤ M := by + have hM : 0 ≤ M := (norm_nonneg (a 0)).trans (ha 0 (by norm_num)) + have hvc : ContinuousOn v (Icc (0 : ℝ) 1) := + fun s hs ↦ (hv s hs).continuousAt.continuousWithinAt + have hvi : IntervalIntegrable v volume 0 1 := + hvc.intervalIntegrable_of_Icc (by norm_num) + have hFTC : (∫ s in (0 : ℝ)..1, v s) = x 1 - x 0 := by + apply intervalIntegral.integral_eq_sub_of_hasDerivAt _ hvi + simpa only [uIcc_of_le (show (0 : ℝ) ≤ 1 by norm_num)] using hx + have hid : (∫ s in (0 : ℝ)..1, (v t - v s)) = v t - (x 1 - x 0) := by + rw [intervalIntegral.integral_sub intervalIntegrable_const hvi, + intervalIntegral.integral_const, hFTC] + simp + rw [← hid] + have hbound : ∀ s ∈ Ι (0 : ℝ) 1, ‖v t - v s‖ ≤ M := by + intro s hs + have hs' : s ∈ Icc (0 : ℝ) 1 := by + have hs'' : s ∈ Ioc (0 : ℝ) 1 := by simpa using hs + exact ⟨le_of_lt hs''.1, hs''.2⟩ + have hmean := Convex.norm_image_sub_le_of_norm_hasDerivWithin_le + (fun u hu ↦ (hv u hu).hasDerivWithinAt) ha (convex_Icc (0 : ℝ) 1) hs' ht + have hdist : ‖t - s‖ ≤ (1 : ℝ) := by + rw [Real.norm_eq_abs] + exact abs_le.mpr ⟨by linarith [ht.1, hs'.2], by linarith [ht.2, hs'.1]⟩ + exact hmean.trans ((mul_le_mul_of_nonneg_left hdist hM).trans_eq (mul_one M)) + simpa using intervalIntegral.norm_integral_le_of_norm_le_const hbound + +/-- The corresponding position differs from its affine chord by at most `M`. -/ +theorem position_chord_bound (x v a : ℝ → V) (M : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (ha : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t‖ ≤ M) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖x t - ((1 - t) • x 0 + t • x 1)‖ ≤ M := by + have hM : 0 ≤ M := (norm_nonneg (a 0)).trans (ha 0 (by norm_num)) + let y : ℝ → V := fun s ↦ x s - (x 0 + s • (x 1 - x 0)) + have hy : ∀ s ∈ Icc (0 : ℝ) 1, + HasDerivWithinAt y (v s - (x 1 - x 0)) (Icc (0 : ℝ) 1) s := by + intro s hs + simpa [y] using ((hx s hs).fun_sub ((hasDerivAt_id s).smul_const (x 1 - x 0) |>.const_add (x + 0))).hasDerivWithinAt + have hb : ∀ s ∈ Icc (0 : ℝ) 1, ‖v s - (x 1 - x 0)‖ ≤ M := + fun s hs ↦ velocity_secant_bound x v a M hx hv ha s hs + have hmean := Convex.norm_image_sub_le_of_norm_hasDerivWithin_le hy hb + (convex_Icc (0 : ℝ) 1) (show (0 : ℝ) ∈ Icc (0 : ℝ) 1 by norm_num) ht + have hform : y t - y 0 = x t - ((1 - t) • x 0 + t • x 1) := by + dsimp [y] + module + rw [hform] at hmean + have hdist : ‖t - 0‖ ≤ (1 : ℝ) := by simpa [Real.norm_eq_abs, abs_of_nonneg ht.1] using ht.2 + exact hmean.trans ((mul_le_mul_of_nonneg_left hdist hM).trans_eq (mul_one M)) + +/-- Zero endpoint data convert the secant estimate to a velocity estimate. -/ +theorem dirichlet_velocity_bound (x v a : ℝ → V) (M : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (ha : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t‖ ≤ M) + (hx0 : x 0 = 0) (hx1 : x 1 = 0) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : ‖v t‖ ≤ M := by + simpa only [hx0, hx1, sub_self, sub_zero] using + velocity_secant_bound x v a M hx hv ha t ht + +/-- Zero endpoint data convert the chord estimate to a position estimate. -/ +theorem dirichlet_position_bound (x v a : ℝ → V) (M : ℝ) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (ha : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t‖ ≤ M) + (hx0 : x 0 = 0) (hx1 : x 1 = 0) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : ‖x t‖ ≤ M := by + simpa only [hx0, hx1, smul_zero, add_zero, sub_zero] using + position_chord_bound x v a M hx hv ha t ht + +/-- A curve with zero acceleration and zero endpoints vanishes identically. -/ +theorem dirichlet_unique (x v : ℝ → V) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v 0 t) + (hx0 : x 0 = 0) (hx1 : x 1 = 0) + (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : x t = 0 := by + apply norm_eq_zero.mp + exact le_antisymm + (dirichlet_position_bound x v (fun _ ↦ 0) 0 hx hv (by simp) hx0 hx1 t ht) + (norm_nonneg _) + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Imports.lean b/LeanPool/PlanarMidpoint/Imports.lean new file mode 100644 index 0000000000..faccc2ad39 --- /dev/null +++ b/LeanPool/PlanarMidpoint/Imports.lean @@ -0,0 +1,38 @@ +/- +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.PlanarMidpoint +public import LeanPool.PlanarMidpoint.Algebra +public import LeanPool.PlanarMidpoint.AnalyticObstruction +public import LeanPool.PlanarMidpoint.ApproximationRemainder +public import LeanPool.PlanarMidpoint.BVPStability +public import LeanPool.PlanarMidpoint.Basic +public import LeanPool.PlanarMidpoint.CanonicalMidpoints +public import LeanPool.PlanarMidpoint.Coordinates +public import LeanPool.PlanarMidpoint.Covariance +public import LeanPool.PlanarMidpoint.DifferentialRigidity +public import LeanPool.PlanarMidpoint.ExceptionalGeometry +public import LeanPool.PlanarMidpoint.FiveDirections +public import LeanPool.PlanarMidpoint.GeodesicBVP +public import LeanPool.PlanarMidpoint.GeodesicDefinitions +public import LeanPool.PlanarMidpoint.GeodesicEstimate +public import LeanPool.PlanarMidpoint.GeodesicFlow +public import LeanPool.PlanarMidpoint.GreenContinuous +public import LeanPool.PlanarMidpoint.GreenOperator +public import LeanPool.PlanarMidpoint.JetAlgebra +public import LeanPool.PlanarMidpoint.LocalBounds +public import LeanPool.PlanarMidpoint.MidpointFourthJet +public import LeanPool.PlanarMidpoint.MidpointGerms +public import LeanPool.PlanarMidpoint.MidpointRigidity +public import LeanPool.PlanarMidpoint.Negation +public import LeanPool.PlanarMidpoint.SpatialTaylor +public import LeanPool.PlanarMidpoint.TangentAlgebra +public import LeanPool.PlanarMidpoint.TangentGeometry +public import LeanPool.PlanarMidpoint.TensorBounds +public import LeanPool.PlanarMidpoint.TensorSemantics +public import LeanPool.PlanarMidpoint.Topology diff --git a/LeanPool/PlanarMidpoint/JetAlgebra.lean b/LeanPool/PlanarMidpoint/JetAlgebra.lean new file mode 100644 index 0000000000..c94786fbcf --- /dev/null +++ b/LeanPool/PlanarMidpoint/JetAlgebra.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.MidpointFourthJet +public import Mathlib.Analysis.Normed.Group.Bounded +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +/-! Exact fourth-order approximate-geodesic identities. -/ + +@[expose] public section +noncomputable section +namespace PlanarMidpoint + +/-- A bilinear second derivative of a planar cubic coefficient field. -/ +abbrev Hessian := E →L[ℝ] E →L[ℝ] Coeff + +/-- The polynomial tail after removing the first three force coefficients. -/ +def forceTail (c c₁ c₂ c₃ : Coeff) (v₁ v₂ v₃ v₄ : E) (ε : ℝ) : E := + let W₃ := v₃ + ε • v₄ + let W₂ := v₂ + ε • W₃ + let U := v₁ + ε • W₂ + 2 • K c v₁ v₄ + 2 • K c v₂ W₃ + ε • K c W₃ W₃ + 2 • K c₁ v₁ W₃ + K c₁ W₂ W₂ + 2 • K c₂ v₁ W₂ + ε + • K c₂ W₂ W₂ + K c₃ U U + +/-- Exact trilinear expansion, with no division by the small parameter. -/ +theorem force_expansion (c c₁ c₂ c₃ : Coeff) (v₁ v₂ v₃ v₄ : E) (ε : ℝ) : + K (c + ε • c₁ + ε ^ 2 • c₂ + ε ^ 3 • c₃) + (ε • v₁ + ε ^ 2 • v₂ + ε ^ 3 • v₃ + ε ^ 4 • v₄) + (ε • v₁ + ε ^ 2 • v₂ + ε ^ 3 • v₃ + ε ^ 4 • v₄) = + ε ^ 2 • K c v₁ v₁ + ε ^ 3 • (2 • K c v₁ v₂ + K c₁ v₁ v₁) + ε ^ 4 • (2 • K c v₁ v₃ + K c v₂ v₂ + + 2 • K c₁ v₁ v₂ + K c₂ v₁ v₁) + ε ^ 5 • forceTail c c₁ c₂ c₃ v₁ v₂ v₃ v₄ ε := by + apply vec_ext <;> simp [K, forceTail] <;> ring + +/-- The exact coefficient-field Taylor tail induced by a quartic displacement. -/ +def coefficientTail (J : E →L[ℝ] Coeff) (H : Hessian) + (d₁ d₂ d₃ d₄ : E) (ε : ℝ) : Coeff := + let D := d₂ + ε • d₃ + ε ^ 2 • d₄ + J (d₃ + ε • d₄) + (1 / 2 : ℝ) • (H d₁ D + H D d₁) + (ε / 2) • H D D + +/-- Exact substitution into the quadratic spatial Taylor polynomial. -/ +theorem coefficient_expansion (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (d₁ d₂ d₃ d₄ : E) (ε : ℝ) : + let δ := ε • d₁ + ε ^ 2 • d₂ + ε ^ 3 • d₃ + ε ^ 4 • d₄ + c + J δ + (1 / 2 : ℝ) • H δ δ = + c + ε • J d₁ + ε ^ 2 • (J d₂ + (1 / 2 : ℝ) • H d₁ d₁) + ε ^ 3 • coefficientTail J H d₁ d₂ d₃ + d₄ ε := by + ext i + simp [coefficientTail, map_add, map_smul] + ring + +/-- The quadratic Dirichlet jet. -/ +def secondJet (c : Coeff) (h : E) (t : ℝ) : E := + (1 / 8 - (1 / 2) * (t - 1 / 2) ^ 2 : ℝ) • K c h h + +/-- The cubic Dirichlet jet. -/ +def thirdJet (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) (t : ℝ) : E := + ((t - 1 / 2) ^ 3 / 6 - (t - 1 / 2) / 24) • cubicJetVector c J h + +/-- The velocity of the quadratic Dirichlet jet. -/ +def secondJetVelocity (c : Coeff) (h : E) (t : ℝ) : E := + (-(t - 1 / 2)) • K c h h + +/-- The velocity of the cubic Dirichlet jet. -/ +def thirdJetVelocity (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) (t : ℝ) : E := + ((t - 1 / 2) ^ 2 / 2 - 1 / 24) • cubicJetVector c J h + +/-- The quartic Dirichlet jet determined by its constant and quadratic acceleration. -/ +def fourthJet (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) (h : E) : ℝ → E := + fourthDirichlet (fourthAccelerationZero c J h) (fourthAccelerationTwo c J (H h h) h) + +/-- The velocity of the quartic Dirichlet jet. -/ +def fourthJetVelocity (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (t : ℝ) : E := + (t - 1 / 2) • fourthAccelerationZero c J h + ((t - 1 / 2) ^ 3 / 3) • fourthAccelerationTwo c J + (H h h) h + +/-- Quartic endpoint-matched approximate geodesic, relative to its center. -/ +def approxDisplacement (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + ε • ((t - 1 / 2) • h) + ε ^ 2 • secondJet c h t + ε ^ 3 • thirdJet c J h t + ε ^ 4 • fourthJet c + J H h t + +/-- The velocity of the fourth-order endpoint-matched approximate geodesic. -/ +def approxVelocity (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + ε • h + ε ^ 2 • secondJetVelocity c h t + ε ^ 3 • thirdJetVelocity c J h t + ε ^ 4 • + fourthJetVelocity c J H h t + +/-- The acceleration of the fourth-order approximate geodesic. -/ +def approxAcceleration (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + ε ^ 2 • (-K c h h) + ε ^ 3 • ((t - 1 / 2) • cubicJetVector c J h) + ε ^ 4 • + (fourthAccelerationZero c J h + (t - 1 / 2) ^ 2 • fourthAccelerationTwo c J (H h h) h) + +@[simp] theorem secondJet_zero (c : Coeff) (h : E) : secondJet c h 0 = 0 := by + norm_num [secondJet] +@[simp] theorem secondJet_one (c : Coeff) (h : E) : secondJet c h 1 = 0 := by + norm_num [secondJet] +@[simp] theorem thirdJet_zero (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : + thirdJet c J h 0 = 0 := by norm_num [thirdJet] +@[simp] theorem thirdJet_one (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : + thirdJet c J h 1 = 0 := by norm_num [thirdJet] + +@[simp] theorem approxDisplacement_zero (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε : ℝ) : + approxDisplacement c J H h ε 0 = (-ε / 2) • h := by + norm_num [approxDisplacement, fourthJet] + module + +@[simp] theorem approxDisplacement_one (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε : ℝ) : + approxDisplacement c J H h ε 1 = (ε / 2) • h := by + norm_num [approxDisplacement, fourthJet] + module + +theorem hasDerivAt_secondJet (c : Coeff) (h : E) (t : ℝ) : + HasDerivAt (secondJet c h) (secondJetVelocity c h t) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + convert (((hs.pow 2).const_mul (1 / 2)).const_sub (1 / 8)).smul_const (K c h h) using 1 <;> + ext <;> simp [secondJet, secondJetVelocity] + +theorem hasDerivAt_secondJetVelocity (c : Coeff) (h : E) (t : ℝ) : + HasDerivAt (secondJetVelocity c h) (-K c h h) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + change HasDerivAt (fun s ↦ secondJetVelocity c h s) _ t + simpa [secondJetVelocity] using hs.neg.smul_const (K c h h) + +theorem hasDerivAt_thirdJet (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) (t : ℝ) : + HasDerivAt (thirdJet c J h) (thirdJetVelocity c J h t) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + convert (((hs.pow 3).div_const 6).sub (hs.div_const 24)).smul_const + (cubicJetVector c J h) using 1 <;> + ext <;> simp [thirdJet, thirdJetVelocity]; ring_nf; simp + +theorem hasDerivAt_thirdJetVelocity (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) (t : ℝ) : + HasDerivAt (thirdJetVelocity c J h) ((t - 1 / 2) • cubicJetVector c J h) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + convert (((hs.pow 2).div_const 2).sub_const (1 / 24)).smul_const + (cubicJetVector c J h) using 1 <;> + ext <;> simp [thirdJetVelocity] + +theorem hasDerivAt_approxDisplacement (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε t : ℝ) : + HasDerivAt (approxDisplacement c J H h ε) (approxVelocity c J H h ε t) t := by + have h₁ := (((hasDerivAt_id t).sub_const (1 / 2 : ℝ)).smul_const h).const_smul ε + have h₂ := (hasDerivAt_secondJet c h t).const_smul (ε ^ 2) + have h₃ := (hasDerivAt_thirdJet c J h t).const_smul (ε ^ 3) + have h₄ := (hasDerivAt_fourthDirichlet (fourthAccelerationZero c J h) + (fourthAccelerationTwo c J (H h h) h) t).const_smul (ε ^ 4) + change HasDerivAt (fun s ↦ approxDisplacement c J H h ε s) _ t + simpa [approxDisplacement, approxVelocity, fourthJet, fourthJetVelocity] using + ((h₁.fun_add h₂).fun_add h₃).fun_add h₄ + +theorem hasDerivAt_approxVelocity (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε t : ℝ) : + HasDerivAt (approxVelocity c J H h ε) (approxAcceleration c J H h ε t) t := by + have h₁ := hasDerivAt_const t (ε • h) + have h₂ := (hasDerivAt_secondJetVelocity c h t).const_smul (ε ^ 2) + have h₃ := (hasDerivAt_thirdJetVelocity c J h t).const_smul (ε ^ 3) + have h₄ := (hasDerivAt_fourthDirichlet_velocity (fourthAccelerationZero c J h) + (fourthAccelerationTwo c J (H h h) h) t).const_smul (ε ^ 4) + change HasDerivAt (fun s ↦ approxVelocity c J H h ε s) _ t + simpa [approxVelocity, approxAcceleration, fourthJetVelocity] using + ((h₁.fun_add h₂).fun_add h₃).fun_add h₄ + +private theorem cubic_force_coefficient (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) (t : ℝ) : + 2 • K c h (secondJetVelocity c h t) + K (J ((t - 1 / 2) • h)) h h = + -((t - 1 / 2) • cubicJetVector c J h) := by + apply vec_ext <;> simp [secondJetVelocity, cubicJetVector, K] <;> ring + +private theorem quartic_force_coefficient (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (t : ℝ) : + 2 • K c h (thirdJetVelocity c J h t) + K c (secondJetVelocity c h t) (secondJetVelocity c h t) + + 2 • K (J ((t - 1 / 2) • h)) h (secondJetVelocity c h t) + K (J (secondJet c h t) + (1 / + 2 : ℝ) • H ((t - 1 / 2) • h) ((t - 1 / 2) • h)) h h = + -(fourthAccelerationZero c J h + (t - 1 / 2) ^ 2 • fourthAccelerationTwo c J (H h h) h) := by + apply vec_ext <;> simp [secondJetVelocity, thirdJetVelocity, secondJet, + fourthAccelerationZero, fourthAccelerationTwo, cubicJetVector, K] <;> ring + +/-- The exact fifth-order residual tail for the quadratic spatial model. -/ +def approxResidualTail (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + forceTail c (J ((t - 1 / 2) • h)) + (J (secondJet c h t) + (1 / 2 : ℝ) • H ((t - 1 / 2) • h) ((t - 1 / 2) • h)) + (coefficientTail J H ((t - 1 / 2) • h) (secondJet c h t) + (thirdJet c J h t) (fourthJet c J H h t) ε) + h (secondJetVelocity c h t) (thirdJetVelocity c J h t) (fourthJetVelocity c J H h t) ε + +/-- The approximate geodesic solves the quadratic spatial model through order four. +The remainder is a polynomial expression, including at `ε=0`. -/ +theorem approx_residual_exact (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : + let δ := approxDisplacement c J H h ε t + approxAcceleration c J H h ε t + K (c + J δ + (1 / 2 : ℝ) • H δ δ) + (approxVelocity c J H h ε t) (approxVelocity c J H h ε t) = + ε ^ 5 • approxResidualTail c J H h ε t := by + dsimp only + unfold approxDisplacement approxVelocity + rw [coefficient_expansion, force_expansion, cubic_force_coefficient, quartic_force_coefficient] + unfold approxAcceleration approxResidualTail + module + +/-- Removing the explicit small parameter from the approximate displacement. -/ +def approxDisplacementScaled (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + (t - 1 / 2) • h + ε • secondJet c h t + ε ^ 2 • thirdJet c J h t + ε ^ 3 • fourthJet c J H h t + +/-- Removing the explicit small parameter from the approximate velocity. -/ +def approxVelocityScaled (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : E := + h + ε • secondJetVelocity c h t + ε ^ 2 • thirdJetVelocity c J h t + ε ^ 3 • fourthJetVelocity c + J H h t + +theorem approxDisplacement_factor (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : + approxDisplacement c J H h ε t = ε • approxDisplacementScaled c J H h ε t := by + unfold approxDisplacement approxDisplacementScaled + module + +theorem approxVelocity_factor (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) + (h : E) (ε t : ℝ) : + approxVelocity c J H h ε t = ε • approxVelocityScaled c J H h ε t := by + unfold approxVelocity approxVelocityScaled + module + +@[fun_prop] theorem continuous_approxDisplacementScaled (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) : + Continuous (fun p : ℝ × ℝ ↦ approxDisplacementScaled c J H h p.1 p.2) := by + unfold approxDisplacementScaled secondJet thirdJet fourthJet fourthDirichlet + fun_prop + +@[fun_prop] theorem continuous_approxVelocityScaled (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) : + Continuous (fun p : ℝ × ℝ ↦ approxVelocityScaled c J H h p.1 p.2) := by + unfold approxVelocityScaled secondJetVelocity thirdJetVelocity fourthJetVelocity + fun_prop + +@[fun_prop] theorem continuous_K_family {X : Type*} [TopologicalSpace X] + {c : X → Coeff} {u v : X → E} (hc : Continuous c) (hu : Continuous u) + (hv : Continuous v) : Continuous (fun x ↦ K (c x) (u x) (v x)) := by + unfold K vec + fun_prop + +@[fun_prop] theorem continuous_approxResidualTail (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) : + Continuous (fun p : ℝ × ℝ ↦ approxResidualTail c J H h p.1 p.2) := by + unfold approxResidualTail forceTail coefficientTail secondJet thirdJet fourthJet + fourthDirichlet secondJetVelocity thirdJetVelocity fourthJetVelocity + fun_prop + +/-- Uniform estimates on the compact parameter rectangle. The displacement and +velocity bounds include their explicit first-order small parameter. -/ +theorem approx_uniform_bounds (c : Coeff) (J : E →L[ℝ] Coeff) (H : Hessian) (h : E) : + ∃ B : ℝ, 1 ≤ B ∧ ∃ R : ℝ, 0 ≤ R ∧ + ∀ ε t : ℝ, |ε| ≤ 1 → t ∈ Set.Icc (0 : ℝ) 1 → + ‖approxDisplacement c J H h ε t‖ ≤ B * |ε| ∧ + ‖approxVelocity c J H h ε t‖ ≤ B * |ε| ∧ + ‖approxResidualTail c J H h ε t‖ ≤ R := by + let S : Set (ℝ × ℝ) := Set.Icc (-1 : ℝ) 1 ×ˢ Set.Icc (0 : ℝ) 1 + have hS : IsCompact S := isCompact_Icc.prod isCompact_Icc + obtain ⟨D, hD⟩ := hS.exists_bound_of_continuousOn + (continuous_approxDisplacementScaled c J H h).continuousOn + obtain ⟨V, hV⟩ := hS.exists_bound_of_continuousOn + (continuous_approxVelocityScaled c J H h).continuousOn + obtain ⟨T, hT⟩ := hS.exists_bound_of_continuousOn + (continuous_approxResidualTail c J H h).continuousOn + let B := max 1 (max D V) + have hDB : D ≤ B := (le_max_left D V).trans (le_max_right 1 (max D V)) + have hVB : V ≤ B := (le_max_right D V).trans (le_max_right 1 (max D V)) + refine ⟨B, le_max_left _ _, max 0 T, le_max_left _ _, ?_⟩ + intro ε t hε ht + have hp : (ε, t) ∈ S := ⟨abs_le.mp hε, ht⟩ + refine ⟨?_, ?_, (hT (ε, t) hp).trans (le_max_right _ _)⟩ + · rw [approxDisplacement_factor, norm_smul, Real.norm_eq_abs] + calc + |ε| * ‖approxDisplacementScaled c J H h ε t‖ ≤ |ε| * B := + mul_le_mul_of_nonneg_left ((hD (ε, t) hp).trans hDB) (abs_nonneg ε) + _ = B * |ε| := mul_comm _ _ + · rw [approxVelocity_factor, norm_smul, Real.norm_eq_abs] + calc + |ε| * ‖approxVelocityScaled c J H h ε t‖ ≤ |ε| * B := + mul_le_mul_of_nonneg_left ((hV (ε, t) hp).trans hVB) (abs_nonneg ε) + _ = B * |ε| := mul_comm _ _ + +/-- Midpoint value of the approximate geodesic. -/ +theorem approxDisplacement_midpoint (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε : ℝ) : + approxDisplacement c J H h ε (1 / 2) = + (ε ^ 2 / 8) • K c h h + ε ^ 4 • fourthMidpointCoefficient c J (H h h) h := by + simp only [approxDisplacement, secondJet, thirdJet, fourthJet, + fourthDirichlet_coefficient] + norm_num + module + +/-- The opposite approximate midpoints retain exactly the quartic obstruction. -/ +theorem approxDisplacement_add_opposite_midpoint (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Hessian) (h : E) (ε : ℝ) : + approxDisplacement c J H h ε (1 / 2) + approxDisplacement (-c) (-J) (-H) h ε (1 / 2) = + (ε ^ 4 / 192) • obstruction c J h := by + have hk : K (-c) h h = -K c h h := by + apply vec_ext <;> simp [K] <;> ring + rw [approxDisplacement_midpoint, approxDisplacement_midpoint] + simp only [neg_apply, hk] + calc + (ε ^ 2 / 8) • K c h h + ε ^ 4 • fourthMidpointCoefficient c J (H h h) h + ((ε ^ 2 / 8) • -K c + h h + ε ^ 4 • fourthMidpointCoefficient (-c) (-J) (-(H h h)) h) = + ε ^ 4 • (fourthMidpointCoefficient c J (H h h) h + fourthMidpointCoefficient (-c) (-J) (-(H + h h)) h) := by module + _ = _ := by + rw [fourthMidpointCoefficient_add_opposite] + module + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/LocalBounds.lean b/LeanPool/PlanarMidpoint/LocalBounds.lean new file mode 100644 index 0000000000..c899e46d5b --- /dev/null +++ b/LeanPool/PlanarMidpoint/LocalBounds.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Analysis.Calculus.ContDiff.RCLike +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity + +/-! Local coefficient bounds with an explicit smallness margin for the BVP estimate. -/ + +@[expose] public section + +open Set Metric +open scoped ContDiff + +namespace PlanarMidpoint + +theorem local_coefficient_bounds {Ω : Set E} {C : E → Coeff} {p : E} + (hΩ : IsOpen Ω) (hp : p ∈ Ω) (hC : ContDiffOn ℝ 2 C Ω) : + ∃ r > (0 : ℝ), ∃ M ≥ (0 : ℝ), ∃ L ≥ (0 : ℝ), + ball p r ⊆ Ω ∧ + (∀ x ∈ ball p r, ‖C x‖ ≤ M) ∧ + (∀ x ∈ ball p r, ∀ y ∈ ball p r, ‖C x - C y‖ ≤ L * ‖x - y‖) ∧ + 8 * L * r ^ 2 + 16 * M * r < 1 / 2 := by + have hc : ContDiffAt ℝ 1 C p := + ((hC p hp).contDiffAt (hΩ.mem_nhds hp)).of_le (by norm_num) + obtain ⟨L, U, hU, hLip⟩ := hc.exists_lipschitzOnWith + obtain ⟨e, he, heU⟩ := Metric.mem_nhds_iff.mp (Filter.inter_mem hU (hΩ.mem_nhds hp)) + let M : ℝ := ‖C p‖ + L + have hM : 0 ≤ M := add_nonneg (norm_nonneg _) L.coe_nonneg + have hs : 0 < (L : ℝ) + M + 1 := by positivity + let r := min e (min 1 ((64 * ((L : ℝ) + M + 1))⁻¹)) + have hr : 0 < r := lt_min he (lt_min (by norm_num) (inv_pos.mpr (by positivity))) + have hre : r ≤ e := min_le_left _ _ + have hr1 : r ≤ 1 := (min_le_right _ _).trans (min_le_left _ _) + have hri : r ≤ (64 * ((L : ℝ) + M + 1))⁻¹ := (min_le_right _ _).trans (min_le_right _ _) + have hsub : ball p r ⊆ U ∩ Ω := fun x hx => heU (ball_subset_ball hre hx) + refine ⟨r, hr, M, hM, L, L.coe_nonneg, fun x hx => (hsub hx).2, ?_, ?_, ?_⟩ + · intro x hx + have hpU : p ∈ U := (heU (mem_ball_self he)).1 + have hb := hLip.norm_sub_le (hsub hx).1 hpU + have hd : ‖x - p‖ ≤ 1 := (mem_ball.mp hx).le.trans hr1 + calc + ‖C x‖ ≤ ‖C x - C p‖ + ‖C p‖ := norm_le_norm_sub_add _ _ + _ ≤ (L : ℝ) * ‖x - p‖ + ‖C p‖ := add_le_add hb le_rfl + _ ≤ M := by dsimp [M]; nlinarith [mul_le_mul_of_nonneg_left hd L.coe_nonneg] + · intro x hx y hy + exact hLip.norm_sub_le (hsub hx).1 (hsub hy).1 + · have hi : r * (64 * ((L : ℝ) + M + 1)) ≤ 1 := by + rw [inv_eq_one_div] at hri + exact (le_div_iff₀ (by positivity)).mp hri + have hrs : r ^ 2 ≤ r := by nlinarith + have hLr := mul_le_mul_of_nonneg_left hrs L.coe_nonneg + have hL0 := mul_nonneg L.coe_nonneg hr.le + nlinarith + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/MidpointFourthJet.lean b/LeanPool/PlanarMidpoint/MidpointFourthJet.lean new file mode 100644 index 0000000000..c0c51a609a --- /dev/null +++ b/LeanPool/PlanarMidpoint/MidpointFourthJet.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Analysis.Calculus.Deriv.Polynomial +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +/-! +# Fourth-order geodesic midpoint algebra + +This file checks the Dirichlet polynomial normalization and the cancellation +between opposite Christoffel tensors. The coefficients use divided derivatives: +`u_j = (1/j!) ∂ε^j γ`. No analytic expansion is assumed in these identities. +-/ + +@[expose] public section + +noncomputable section + +namespace PlanarMidpoint + +private theorem jet_K_neg_coeff (c : Coeff) (u v : E) : + K (-c) u v = -K c u v := by + apply vec_ext <;> simp [K] <;> ring + +private theorem jet_K_neg_left (c : Coeff) (u v : E) : + K c (-u) v = -K c u v := by + apply vec_ext <;> simp [K] <;> ring + +private theorem jet_K_neg_right (c : Coeff) (u v : E) : + K c u (-v) = -K c u v := by + apply vec_ext <;> simp [K] <;> ring + +/-- The obstruction is even when the connection and its spatial derivative +are simultaneously negated. -/ +theorem obstruction_neg (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : + obstruction (-c) (-J) h = obstruction c J h := by + simp [obstruction, jet_K_neg_coeff, jet_K_neg_right] + +/-- The second and fourth even Dirichlet primitives of `B₀ + B₂(t-1/2)²`. -/ +def fourthDirichlet (B₀ B₂ : E) (t : ℝ) : E := + (((t - 1 / 2) ^ 2 - 1 / 4) / 2) • B₀ + (((t - 1 / 2) ^ 4 - 1 / 16) / 12) • B₂ + +@[simp] theorem fourthDirichlet_zero (B₀ B₂ : E) : + fourthDirichlet B₀ B₂ 0 = 0 := by + norm_num [fourthDirichlet] + +@[simp] theorem fourthDirichlet_one (B₀ B₂ : E) : + fourthDirichlet B₀ B₂ 1 = 0 := by + norm_num [fourthDirichlet] + +theorem fourthDirichlet_midpoint (B₀ B₂ : E) : + fourthDirichlet B₀ B₂ (1 / 2) = -(1 / 8 : ℝ) • B₀ - (1 / 192 : ℝ) • B₂ := by + norm_num [fourthDirichlet, sub_eq_add_neg, ← neg_smul] + +theorem hasDerivAt_fourthDirichlet (B₀ B₂ : E) (t : ℝ) : + HasDerivAt (fourthDirichlet B₀ B₂) + ((t - 1 / 2) • B₀ + ((t - 1 / 2) ^ 3 / 3) • B₂) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + convert ((((hs.pow 2).sub_const (1 / 4)).div_const 2).smul_const B₀).add + ((((hs.pow 4).sub_const (1 / 16)).div_const 12).smul_const B₂) using 1 <;> + ext <;> simp [fourthDirichlet]; ring_nf; simp + +theorem hasDerivAt_fourthDirichlet_velocity (B₀ B₂ : E) (t : ℝ) : + HasDerivAt (fun s : ℝ ↦ (s - 1 / 2) • B₀ + ((s - 1 / 2) ^ 3 / 3) • B₂) + (B₀ + (t - 1 / 2) ^ 2 • B₂) t := by + have hs := (hasDerivAt_id t).sub_const (1 / 2 : ℝ) + convert (hs.smul_const B₀).add (((hs.pow 3).div_const 3).smul_const B₂) using 1 <;> + ext <;> simp + +/-- The quartic midpoint coefficient after solving the Dirichlet jet equations. +`H` denotes `(D_h²K)` in coefficient coordinates. -/ +def fourthMidpointCoefficient (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Coeff) (h : E) : E := + (1 / 384 : ℝ) • (-4 • K c h (K c h (K c h h)) + 2 • K c (K c h h) (K c h h) + K H h h + + obstruction c J h) + +/-- The cubic jet vector `n = 2K(h,K(h,h)) - (D_hK)(h,h)`. -/ +def cubicJetVector (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : E := + 2 • K c h (K c h h) - K (J h) h h + +/-- Constant term of the fourth jet's acceleration in centered time. -/ +def fourthAccelerationZero (c : Coeff) (J : E →L[ℝ] Coeff) (h : E) : E := + (1 / 12 : ℝ) • K c h (cubicJetVector c J h) - (1 / 8 : ℝ) • K (J (K c h h)) h h + +/-- Quadratic term of the fourth jet's acceleration in centered time. -/ +def fourthAccelerationTwo (c : Coeff) (J : E →L[ℝ] Coeff) (H : Coeff) (h : E) : E := + -K c h (cubicJetVector c J h) - K c (K c h h) (K c h h) + 2 • K (J h) h (K c h h) + (1 / 2 : ℝ) + • K (J (K c h h)) h h - (1 / 2 : ℝ) • K H h h + +/-- Solving the quartic Dirichlet equation gives the exact coefficient. -/ +theorem fourthDirichlet_coefficient (c : Coeff) (J : E →L[ℝ] Coeff) + (H : Coeff) (h : E) : + fourthDirichlet (fourthAccelerationZero c J h) + (fourthAccelerationTwo c J H h) (1 / 2) = fourthMidpointCoefficient c J H h := by + rw [fourthDirichlet_midpoint] + apply vec_ext <;> simp [fourthAccelerationZero, fourthAccelerationTwo, + fourthMidpointCoefficient, cubicJetVector, obstruction, K] <;> ring + +/-- Opposite connections cancel every quartic contribution except the +first-order obstruction. -/ +theorem fourthMidpointCoefficient_add_opposite (c : Coeff) + (J : E →L[ℝ] Coeff) (H : Coeff) (h : E) : + fourthMidpointCoefficient c J H h + fourthMidpointCoefficient (-c) (-J) (-H) h = + (1 / 192 : ℝ) • obstruction c J h := by + simp only [fourthMidpointCoefficient, jet_K_neg_coeff, jet_K_neg_left, + jet_K_neg_right, neg_neg, obstruction_neg] + module + +/-- Multiplication by `4!` converts the sum of divided quartic coefficients +into the fourth derivative of the midpoint defect. -/ +theorem fourth_defect_factor (c : Coeff) (J : E →L[ℝ] Coeff) (H : Coeff) (h : E) : + (24 : ℝ) • (fourthMidpointCoefficient c J H h + fourthMidpointCoefficient (-c) (-J) (-H) h) = + (1 / 8 : ℝ) • obstruction c J h := by + rw [fourthMidpointCoefficient_add_opposite, smul_smul] + norm_num + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/MidpointGerms.lean b/LeanPool/PlanarMidpoint/MidpointGerms.lean new file mode 100644 index 0000000000..ca19b384cf --- /dev/null +++ b/LeanPool/PlanarMidpoint/MidpointGerms.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.GeodesicDefinitions +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Tactic.NormNum + +/-! Restricting canonical midpoint germs to arbitrarily small geodesic neighborhoods. -/ + +@[expose] public section + +open Set Metric + +namespace PlanarMidpoint + +theorem IsShortGeodesic.mono_radius {C : E → Coeff} {σ r s : ℝ} + {p P Q : E} {γ v : ℝ → E} + (h : IsShortGeodesic C σ p r P Q γ v) (hrs : r ≤ s) : + IsShortGeodesic C σ p s P Q γ v := by + obtain ⟨hg, h0, h1, hb⟩ := h + refine ⟨hg, h0, h1, fun t ht => ?_⟩ + exact ⟨(hb t ht).1.trans_le hrs, (hb t ht).2.trans_le hrs⟩ + +/-- Canonical uniqueness identifies all sufficiently small representatives. +The small-solution existence premise is supplied by the local BVP theorem. -/ +theorem arbitrarilyShortPairs_of_canonical + {Ω : Set E} {C : E → Coeff} {p : E} + (hlocal : LocalMidpointInvariance Ω C) (hp : p ∈ Ω) + (hexists : ∀ σ ∈ ({1, -1} : Set ℝ), ∀ r > (0 : ℝ), + ∃ δ > (0 : ℝ), ∀ P Q, P ∈ ball p δ → Q ∈ ball p δ → + ∃ γ v, IsShortGeodesic C σ p r P Q γ v) : + ArbitrarilyShortComplementaryPairs C p := by + obtain ⟨rp, rm, W, Ap, Am, hAp, hAm, hcomp⟩ := hlocal p hp + obtain ⟨hrp, _, hW, hpp, hplus⟩ := hAp + obtain ⟨hrm, _, _, _, hminus⟩ := hAm + obtain ⟨e, he, hball⟩ := Metric.isOpen_iff.mp hW (p, p) hpp + intro r hr + let s := min r (min rp rm) + have hs : 0 < s := lt_min hr (lt_min hrp hrm) + obtain ⟨dp, hdp, hpSol⟩ := hexists 1 (by simp) s hs + obtain ⟨dm, hdm, hmSol⟩ := hexists (-1) (by simp) s hs + refine ⟨min e (min dp dm), lt_min he (lt_min hdp hdm), ?_⟩ + intro P Q hP hQ + have hPe : P ∈ ball p e := mem_ball.mpr ((mem_ball.mp hP).trans_le (min_le_left _ _)) + have hQe : Q ∈ ball p e := mem_ball.mpr ((mem_ball.mp hQ).trans_le (min_le_left _ _)) + have hPQ : (P, Q) ∈ W := hball (by + rw [mem_ball, Prod.dist_eq] + exact max_lt (mem_ball.mp hPe) (mem_ball.mp hQe)) + have hPp : P ∈ ball p dp := mem_ball.mpr + ((mem_ball.mp hP).trans_le ((min_le_right _ _).trans (min_le_left _ _))) + have hQp : Q ∈ ball p dp := mem_ball.mpr + ((mem_ball.mp hQ).trans_le ((min_le_right _ _).trans (min_le_left _ _))) + have hPm : P ∈ ball p dm := mem_ball.mpr + ((mem_ball.mp hP).trans_le ((min_le_right _ _).trans (min_le_right _ _))) + have hQm : Q ∈ ball p dm := mem_ball.mpr + ((mem_ball.mp hQ).trans_le ((min_le_right _ _).trans (min_le_right _ _))) + obtain ⟨γp, vp, hgp⟩ := hpSol P Q hPp hQp + obtain ⟨γm, vm, hgm⟩ := hmSol P Q hPm hQm + obtain ⟨γp', vp', _, hmp, hup⟩ := hplus P Q hPQ + obtain ⟨γm', vm', _, hmm, hum⟩ := hminus P Q hPQ + have heqp := (hup γp vp (hgp.mono_radius ((min_le_right _ _).trans (min_le_left _ _))) + (1 / 2) (by norm_num)).1 + have heqm := (hum γm vm (hgm.mono_radius ((min_le_right _ _).trans (min_le_right _ _))) + (1 / 2) (by norm_num)).1 + refine ⟨γp, vp, γm, vm, hgp.mono_radius (min_le_left _ _), + hgm.mono_radius (min_le_left _ _), ?_⟩ + rw [heqp, heqm, ← hmp, ← hmm] + exact hcomp P Q hPQ + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/MidpointRigidity.lean b/LeanPool/PlanarMidpoint/MidpointRigidity.lean new file mode 100644 index 0000000000..be6bd05c4c --- /dev/null +++ b/LeanPool/PlanarMidpoint/MidpointRigidity.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.DifferentialRigidity +public import LeanPool.PlanarMidpoint.CanonicalMidpoints +public import LeanPool.PlanarMidpoint.AnalyticObstruction +public import Mathlib.Tactic.NormNum + +/-! +# Planar Euclidean midpoint rigidity + +This proves the dimension-two case of Nielsen–Okamura Conjecture 9.1 +(arXiv:2609.07551v2, Section 9). The midpoint hypothesis uses actual canonical +short geodesics of the two Euclidean dual connections. The proof includes +the construction of those local germs and their fourth-order obstruction. +-/ + +@[expose] public section + +open Set +open scoped ContDiff + +namespace PlanarMidpoint + +/-- Twice continuously differentiable coefficients already suffice for planar +dual-geodesic midpoint rigidity. -/ +theorem planar_midpoint_rigidity_C2 (Ω : Set E) (C : E → Coeff) + (openΩ : IsOpen Ω) (connectedΩ : IsPreconnected Ω) + (smoothC : ContDiffOn ℝ 2 C Ω) + (complementary : LocalMidpointInvariance Ω C) : + ∃ c : Coeff, ∀ p ∈ Ω, C p = c := by + apply planar_obstruction_rigidity Ω C openΩ connectedΩ + (smoothC.differentiableOn (by norm_num)) + intro p hp h + exact obstruction_of_short_complementary_pairs openΩ hp smoothC + (localMidpointInvariance_arbitrarilyShort openΩ hp smoothC complementary) h + +/-- Nielsen–Okamura Conjecture 9.1 in dimension two, with its full geometric +midpoint hypothesis and no assumed fourth-order condition. -/ +theorem planar_dual_midpoint_rigidity (Ω : Set E) (C : E → Coeff) + (openΩ : IsOpen Ω) (connectedΩ : IsPreconnected Ω) + (smoothC : ContDiffOn ℝ ∞ C Ω) + (complementary : LocalMidpointInvariance Ω C) : + ∃ c : Coeff, ∀ p ∈ Ω, C p = c := + planar_midpoint_rigidity_C2 Ω C openΩ connectedΩ (smoothC.of_le (by simp)) complementary + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Negation.lean b/LeanPool/PlanarMidpoint/Negation.lean new file mode 100644 index 0000000000..9dfe83924b --- /dev/null +++ b/LeanPool/PlanarMidpoint/Negation.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.JetAlgebra +public import LeanPool.PlanarMidpoint.GeodesicDefinitions +public import Mathlib.Tactic.Ring + +/-! Exact transfers between opposite connection coefficients. -/ + +@[expose] public section +namespace PlanarMidpoint + +/-- Negating the coefficient field and both derivatives preserves the Taylor-error norm. -/ +theorem neg_coeff_taylor_remainder (C : E → Coeff) (p d : E) (c : Coeff) + (J : E →L[ℝ] Coeff) (H : Hessian) : + ‖(-C) (p + d) - (-c) - (-J) d - (1 / 2 : ℝ) • (-H) d d‖ = + ‖C (p + d) - c - J d - (1 / 2 : ℝ) • H d d‖ := by + simp only [Pi.neg_apply, neg_apply] + rw [show - C (p + d) - (-c) - (-J d) - (1 / 2 : ℝ) • (-H d d) = + -(C (p + d) - c - J d - (1 / 2 : ℝ) • H d d) by module] + exact norm_neg _ + +theorem norm_neg_coeff_sub (C : E → Coeff) (p q : E) : + ‖(-C) p - (-C) q‖ = ‖C p - C q‖ := by + simp only [Pi.neg_apply, neg_sub_neg, norm_sub_rev] + +/-- Negating the field exchanges the plus and minus geodesic equations. -/ +theorem isGeodesicSegment_neg (C : E → Coeff) (γ v : ℝ → E) : + IsGeodesicSegment C (-1) γ v ↔ IsGeodesicSegment (-C) 1 γ v := by + have hk (c : Coeff) (u : E) : K (-c) u u = -K c u u := by + apply vec_ext <;> simp [K] <;> ring + simp only [IsGeodesicSegment, Pi.neg_apply, hk, neg_neg, one_smul, + neg_one_smul] + +/-- The shortness and endpoint requirements are unchanged by the sign transfer. -/ +theorem isShortGeodesic_neg (C : E → Coeff) (p : E) (r : ℝ) (P Q : E) (γ v : ℝ → E) : + IsShortGeodesic C (-1) p r P Q γ v ↔ IsShortGeodesic (-C) 1 p r P Q γ v := by + simp only [IsShortGeodesic, isGeodesicSegment_neg] + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/SpatialTaylor.lean b/LeanPool/PlanarMidpoint/SpatialTaylor.lean new file mode 100644 index 0000000000..d09d7a1c8e --- /dev/null +++ b/LeanPool/PlanarMidpoint/SpatialTaylor.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import Mathlib.Analysis.Calculus.ContDiff.Basic +public import Mathlib.Analysis.Calculus.MeanValue +public import Mathlib.Analysis.Calculus.Deriv.Mul +public import Mathlib.Analysis.Calculus.Deriv.Pow +public import Mathlib.Tactic.Convert +public import Mathlib.Tactic.GCongr +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +/-! +# Second-order Taylor estimates along line segments + +The coarse remainder constant is sufficient for uniform geodesic residual +estimates. It follows by two applications of the vector-valued mean-value +inequality and does not invoke parameter smoothness of ODE solutions. +-/ + +@[expose] public section + + +open Set Filter +open scoped Topology + +namespace PlanarMidpoint + +/-- A uniform bound on the change in the second derivative controls the +second-order Taylor remainder at time one. -/ +theorem second_order_line_remainder {V : Type*} + [NormedAddCommGroup V] [NormedSpace ℝ V] + {x v a : ℝ → V} {M : ℝ} (hM : 0 ≤ M) + (hx : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt x (v t) t) + (hv : ∀ t ∈ Icc (0 : ℝ) 1, HasDerivAt v (a t) t) + (ha : ∀ t ∈ Icc (0 : ℝ) 1, ‖a t - a 0‖ ≤ M) : + ‖x 1 - x 0 - v 0 - (1 / 2 : ℝ) • a 0‖ ≤ M := by + let vErr : ℝ → V := fun t ↦ v t - t • a 0 + have hvErr (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + HasDerivAt vErr (a t - a 0) t := by + convert (hv t ht).sub ((hasDerivAt_id t).smul_const (a 0)) using 1 + · rfl + · simp + have hvBound (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖vErr t - vErr 0‖ ≤ M := by + have h := norm_image_sub_le_of_norm_deriv_le_segment' + (fun s hs ↦ (hvErr s hs).hasDerivWithinAt) + (fun s hs ↦ ha s (Ico_subset_Icc_self hs)) t ht + exact h.trans (by simpa only [sub_zero] using mul_le_of_le_one_right hM ht.2) + let xErr : ℝ → V := fun t ↦ x t - t • v 0 - (t ^ 2 / 2) • a 0 + have hxErr (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + HasDerivAt xErr (vErr t - vErr 0) t := by + have hp : HasDerivAt (fun s : ℝ ↦ s ^ 2 / 2) t t := by + convert ((hasDerivAt_id t).pow 2).div_const 2 using 1 <;> simp + convert ((hx t ht).sub ((hasDerivAt_id t).smul_const (v 0))).sub + (hp.smul_const (a 0)) using 1 + · rfl + · dsimp [vErr] + module + have h := norm_image_sub_le_of_norm_deriv_le_segment_01' + (fun s hs ↦ (hxErr s hs).hasDerivWithinAt) + (fun s hs ↦ hvBound s (Ico_subset_Icc_self hs)) + simpa [xErr, sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using h + +/-- A second-order spatial remainder estimate from bounds on the variation of +an actual second Fréchet derivative along the segment. -/ +theorem second_order_spatial_remainder {U V : Type*} + [NormedAddCommGroup U] [NormedSpace ℝ U] + [NormedAddCommGroup V] [NormedSpace ℝ V] + {f : U → V} {J : U → U →L[ℝ] V} {H : U → U →L[ℝ] U →L[ℝ] V} + {S : Set U} {p d : U} {η : ℝ} (hη : 0 ≤ η) + (hseg : ∀ t ∈ Icc (0 : ℝ) 1, p + t • d ∈ S) + (hf : ∀ y ∈ S, HasFDerivAt f (J y) y) + (hJ : ∀ y ∈ S, HasFDerivAt J (H y) y) + (hH : ∀ y ∈ S, ‖H y - H p‖ ≤ η) : + ‖f (p + d) - f p - J p d - (1 / 2 : ℝ) • H p d d‖ ≤ η * ‖d‖ ^ 2 := by + have hline (t : ℝ) : HasDerivAt (fun s : ℝ ↦ p + s • d) d t := by + convert (hasDerivAt_const t p).add ((hasDerivAt_id t).smul_const d) using 1 + · rfl + · simp + have hfline (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + HasDerivAt (fun s : ℝ ↦ f (p + s • d)) (J (p + t • d) d) t := + (hf _ (hseg t ht)).comp_hasDerivAt t (hline t) + have hJline (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + HasDerivAt (fun s : ℝ ↦ J (p + s • d) d) (H (p + t • d) d d) t := by + have hpath : HasDerivAt (fun s : ℝ ↦ J (p + s • d)) + (H (p + t • d) d) t := + (hJ _ (hseg t ht)).comp_hasDerivAt t (hline t) + simpa only [map_zero, add_zero] using hpath.clm_apply (hasDerivAt_const t d) + have hvar (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : + ‖H (p + t • d) d d - H (p + (0 : ℝ) • d) d d‖ ≤ η * ‖d‖ ^ 2 := by + simp only [zero_smul, add_zero] + calc + ‖H (p + t • d) d d - H p d d‖ = ‖((H (p + t • d) - H p) d) d‖ := by rfl + _ ≤ ‖(H (p + t • d) - H p) d‖ * ‖d‖ := ContinuousLinearMap.le_opNorm _ _ + _ ≤ (‖H (p + t • d) - H p‖ * ‖d‖) * ‖d‖ := by + gcongr + exact ContinuousLinearMap.le_opNorm _ _ + _ ≤ (η * ‖d‖) * ‖d‖ := by + gcongr + exact hH _ (hseg t ht) + _ = η * ‖d‖ ^ 2 := by ring + have h := second_order_line_remainder (mul_nonneg hη (sq_nonneg ‖d‖)) + hfline hJline hvar + simpa using h + +/-- A `C²` map has a second-order spatial expansion with a uniformly small +quadratic remainder on a sufficiently small ball. -/ +theorem exists_second_order_spatial_remainder {U V : Type*} + [NormedAddCommGroup U] [NormedSpace ℝ U] + [NormedAddCommGroup V] [NormedSpace ℝ V] + {f : U → V} {Ω : Set U} {p : U} + (hΩ : IsOpen Ω) (hp : p ∈ Ω) (hf : ContDiffOn ℝ 2 f Ω) + {η : ℝ} (hη : 0 < η) : + ∃ r > (0 : ℝ), Metric.ball p r ⊆ Ω ∧ ∀ d : U, ‖d‖ < r → + ‖f (p + d) - f p - fderiv ℝ f p d - (1 / 2 : ℝ) • fderiv ℝ (fderiv ℝ f) p d d‖ ≤ η * ‖d‖ ^ 2 + := by + have hJ : ContDiffOn ℝ 1 (fderiv ℝ f) Ω := hf.fderiv_of_isOpen hΩ (by norm_num) + have hHc : ContinuousAt (fderiv ℝ (fderiv ℝ f)) p := + (hJ.continuousOn_fderiv_of_isOpen hΩ (by norm_num)).continuousAt (hΩ.mem_nhds hp) + have hsmall : ∀ᶠ y in nhds p, + ‖fderiv ℝ (fderiv ℝ f) y - fderiv ℝ (fderiv ℝ f) p‖ < η := by + have h : ∀ᶠ y in nhds p, fderiv ℝ (fderiv ℝ f) y ∈ + Metric.ball (fderiv ℝ (fderiv ℝ f) p) η := + hHc.eventually (Metric.ball_mem_nhds (fderiv ℝ (fderiv ℝ f) p) hη) + filter_upwards [h] with y hy + rw [Metric.mem_ball] at hy + rw [← dist_eq_norm (fderiv ℝ (fderiv ℝ f) y) (fderiv ℝ (fderiv ℝ f) p)] + exact hy + obtain ⟨r, hr, hball⟩ := Metric.eventually_nhds_iff.mp + (hsmall.and (hΩ.mem_nhds hp)) + refine ⟨r, hr, fun y hy ↦ (hball hy).2, ?_⟩ + intro d hd + have hseg (t : ℝ) (ht : t ∈ Icc (0 : ℝ) 1) : p + t • d ∈ Metric.ball p r := by + rw [Metric.mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul, Real.norm_eq_abs, + abs_of_nonneg ht.1] + exact (mul_le_of_le_one_left (norm_nonneg d) ht.2).trans_lt hd + exact second_order_spatial_remainder hη.le hseg + (fun y hy ↦ ((hf.contDiffAt (hΩ.mem_nhds (hball hy).2)).differentiableAt + (by norm_num)).hasFDerivAt) + (fun y hy ↦ ((hJ.contDiffAt (hΩ.mem_nhds (hball hy).2)).differentiableAt + (by norm_num)).hasFDerivAt) + (fun y hy ↦ (hball hy).1.le) + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/TangentAlgebra.lean b/LeanPool/PlanarMidpoint/TangentAlgebra.lean new file mode 100644 index 0000000000..aabe99f32c --- /dev/null +++ b/LeanPool/PlanarMidpoint/TangentAlgebra.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Algebra +public import Mathlib.LinearAlgebra.Matrix.Notation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.NormNum + +/-! +# Exact tangent-kernel certificates + +Linear polynomial combinations of the ten obstruction rows isolate every +coordinate of a tangent to either exceptional graph. +-/ + +@[expose] public section + +namespace PlanarMidpoint + + +/-- The derivative array of a pure-cube tangent, with denominators cleared. -/ +def qTangentArray (s t : ℝ) (w : Fin 4 → ℝ) : Fin 8 → ℝ := + ![(s ^ 4 + 3 * s ^ 2 * t ^ 2) * w 0 + (-2 * s ^ 3 * t) * w 1, + (2 * s * t ^ 3) * w 0 + (s ^ 4 - s ^ 2 * t ^ 2) * w 1, + (-s ^ 2 * t ^ 2 + t ^ 4) * w 0 + (2 * s ^ 3 * t) * w 1, + (-2 * s * t ^ 3) * w 0 + (3 * s ^ 2 * t ^ 2 + t ^ 4) * w 1, + (s ^ 4 + 3 * s ^ 2 * t ^ 2) * w 2 + (-2 * s ^ 3 * t) * w 3, + (2 * s * t ^ 3) * w 2 + (s ^ 4 - s ^ 2 * t ^ 2) * w 3, + (-s ^ 2 * t ^ 2 + t ^ 4) * w 2 + (2 * s ^ 3 * t) * w 3, + (-2 * s * t ^ 3) * w 2 + (3 * s ^ 2 * t ^ 2 + t ^ 4) * w 3] + +theorem q_tangent_kernel (s t : ℝ) (w : Fin 4 → ℝ) + (hρ : s ^ 2 + t ^ 2 ≠ 0) + (h : Algebra.Kernel (s ^ 3) (s ^ 2 * t) (s * t ^ 2) (t ^ 3) (qTangentArray s t w)) : + w = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + norm_num [qTangentArray] at h0 h1 h2 h3 h4 h5 h6 h7 h8 h9 + have hw0 : (s ^ 2 + t ^ 2) ^ 4 * w 0 = 0 := by + have he : 36 * ((s ^ 2 + t ^ 2) ^ 4 * w 0) = 0 := by + linear_combination (12 * s) * h0 + (84 * t) * h1 + (-18 * s) * h2 + (-9 * t) * h3 + (252 * + s) * h4 + (-204 * t) * h5 + (28 * t) * h7 + (-93 * s) * h8 + linarith only [he] + have hw1 : (s ^ 2 + t ^ 2) ^ 4 * w 1 = 0 := by + have he : 36 * ((s ^ 2 + t ^ 2) ^ 4 * w 1) = 0 := by + linear_combination (-24 * t) * h0 + (88 * t) * h2 + (-93 * s) * h3 + (180 * t) * h4 + (36 * + s) * h5 + (-111 * t) * h6 + (52 * s) * h7 + (-18 * t) * h8 + (-96 * s) * h9 + linarith only [he] + have hw2 : (s ^ 2 + t ^ 2) ^ 4 * w 2 = 0 := by + have he : 36 * ((s ^ 2 + t ^ 2) ^ 4 * w 2) = 0 := by + linear_combination (-96 * t) * h0 + (-18 * s) * h1 + (52 * t) * h2 + (-111 * s) * h3 + (36 * + t) * h4 + (180 * s) * h5 + (-93 * t) * h6 + (88 * s) * h7 + (-24 * s) * h9 + linarith only [he] + have hw3 : (s ^ 2 + t ^ 2) ^ 4 * w 3 = 0 := by + have he : 36 * ((s ^ 2 + t ^ 2) ^ 4 * w 3) = 0 := by + linear_combination (-93 * t) * h1 + (28 * s) * h2 + (-204 * s) * h4 + (252 * t) * h5 + (-9 * + s) * h6 + (-18 * t) * h7 + (84 * s) * h8 + (12 * t) * h9 + linarith only [he] + ext i + fin_cases i + · exact (mul_eq_zero.mp hw0).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw1).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw2).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw3).resolve_left (pow_ne_zero 4 hρ) + +/-- The derivative array of a second-graph tangent, with denominators cleared. -/ +def rTangentArray (s t : ℝ) (w : Fin 4 → ℝ) : Fin 8 → ℝ := + ![(-3 * s ^ 2 * t ^ 2 + 3 * t ^ 4) * w 0 + (6 * s ^ 3 * t) * w 1, + (-6 * s * t ^ 3) * w 0 + (-2 * s ^ 4 + 5 * s ^ 2 * t ^ 2 + t ^ 4) * w 1, + (s ^ 4 + 5 * s ^ 2 * t ^ 2 - 2 * t ^ 4) * w 0 + (-6 * s ^ 3 * t) * w 1, + (6 * s * t ^ 3) * w 0 + (3 * s ^ 4 - 3 * s ^ 2 * t ^ 2) * w 1, + (-3 * s ^ 2 * t ^ 2 + 3 * t ^ 4) * w 2 + (6 * s ^ 3 * t) * w 3, + (-6 * s * t ^ 3) * w 2 + (-2 * s ^ 4 + 5 * s ^ 2 * t ^ 2 + t ^ 4) * w 3, + (s ^ 4 + 5 * s ^ 2 * t ^ 2 - 2 * t ^ 4) * w 2 + (-6 * s ^ 3 * t) * w 3, + (6 * s * t ^ 3) * w 2 + (3 * s ^ 4 - 3 * s ^ 2 * t ^ 2) * w 3] + +theorem r_tangent_kernel (s t : ℝ) (w : Fin 4 → ℝ) + (hρ : s ^ 2 + t ^ 2 ≠ 0) + (h : Algebra.Kernel (3 * s * t ^ 2) (-2 * s ^ 2 * t + t ^ 3) (s ^ 3 - 2 * s * t ^ 2) (3 * s ^ + 2 * t) (rTangentArray s t w)) : + w = 0 := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + norm_num [rTangentArray] at h0 h1 h2 h3 h4 h5 h6 h7 h8 h9 + have hw0 : (s ^ 2 + t ^ 2) ^ 4 * w 0 = 0 := by + have he : 349236 * ((s ^ 2 + t ^ 2) ^ 4 * w 0) = 0 := by + linear_combination (198044 * s) * h0 + (-14059 * t) * h1 + (108436 * s) * h2 + (82684 * t) * + h3 + (65600 * s) * h4 + (28576 * t) * h5 + (-79741 * s) * h6 + (-75082 * t) * h7 + + (17002 * s) * h8 + (-92096 * t) * h9 + linarith only [he] + have hw1 : (s ^ 2 + t ^ 2) ^ 4 * w 1 = 0 := by + have he : 843660 * ((s ^ 2 + t ^ 2) ^ 4 * w 1) = 0 := by + linear_combination (378568 * t) * h0 + (-25705 * s) * h1 + (33086 * t) * h2 + (208000 * s) * + h3 + (754768 * t) * h4 + (425152 * s) * h5 + (178570 * t) * h6 + (-57166 * s) * h7 + + (-55135 * t) * h8 + (166672 * s) * h9 + linarith only [he] + have hw2 : (s ^ 2 + t ^ 2) ^ 4 * w 2 = 0 := by + have he : 843660 * ((s ^ 2 + t ^ 2) ^ 4 * w 2) = 0 := by + linear_combination (166672 * t) * h0 + (-55135 * s) * h1 + (-57166 * t) * h2 + (178570 * s) + * h3 + (425152 * t) * h4 + (754768 * s) * h5 + (208000 * t) * h6 + (33086 * s) * h7 + + (-25705 * t) * h8 + (378568 * s) * h9 + linarith only [he] + have hw3 : (s ^ 2 + t ^ 2) ^ 4 * w 3 = 0 := by + have he : 349236 * ((s ^ 2 + t ^ 2) ^ 4 * w 3) = 0 := by + linear_combination (-92096 * s) * h0 + (17002 * t) * h1 + (-75082 * s) * h2 + (-79741 * t) * + h3 + (28576 * s) * h4 + (65600 * t) * h5 + (82684 * s) * h6 + (108436 * t) * h7 + + (-14059 * s) * h8 + (198044 * t) * h9 + linarith only [he] + ext i + fin_cases i + · exact (mul_eq_zero.mp hw0).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw1).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw2).resolve_left (pow_ne_zero 4 hρ) + · exact (mul_eq_zero.mp hw3).resolve_left (pow_ne_zero 4 hρ) + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/TangentGeometry.lean b/LeanPool/PlanarMidpoint/TangentGeometry.lean new file mode 100644 index 0000000000..db8630fc3d --- /dev/null +++ b/LeanPool/PlanarMidpoint/TangentGeometry.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Coordinates +public import LeanPool.PlanarMidpoint.ExceptionalGeometry +public import LeanPool.PlanarMidpoint.TangentAlgebra +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +/-! +# Vanishing of exceptional tangent derivatives + +The derivative of either rational graph intersects the obstruction kernel +only in zero. Denominators are cleared using the strictly positive squared +trace length; the remaining identities are polynomial certificates. +-/ + +@[expose] public section + +namespace PlanarMidpoint + + +private theorem kernel_smul (c : Coeff) (z : DerivativeArray) (α β : ℝ) + (h : Algebra.Kernel (c 0) (c 1) (c 2) (c 3) z) : + Algebra.Kernel ((α • c) 0) ((α • c) 1) ((α • c) 2) ((α • c) 3) (β • z) := by + rcases h with ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9⟩ + simp only [Algebra.Kernel, Pi.smul_apply, smul_eq_mul] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · linear_combination α * β * h0 + · linear_combination α * β * h1 + · linear_combination α * β * h2 + · linear_combination α * β * h3 + · linear_combination α * β * h4 + · linear_combination α * β * h5 + · linear_combination α * β * h6 + · linear_combination α * β * h7 + · linear_combination α * β * h8 + · linear_combination α * β * h9 + +private def traceDerivativeArray (A : E →L[ℝ] E) : Fin 4 → ℝ := + ![A (vec 1 0) 0, A (vec 1 0) 1, A (vec 0 1) 0, A (vec 0 1) 1] + +private theorem traceDerivativeArray_eq_zero (A : E →L[ℝ] E) + (h : traceDerivativeArray A = 0) : A = 0 := by + have h0 : A (vec 1 0) = 0 := by + apply vec_ext + · simpa [traceDerivativeArray] using congrFun h 0 + · simpa [traceDerivativeArray] using congrFun h 1 + have h1 : A (vec 0 1) = 0 := by + apply vec_ext + · simpa [traceDerivativeArray] using congrFun h 2 + · simpa [traceDerivativeArray] using congrFun h 3 + ext v i + conv_lhs => rw [vec_decomp v] + simp [h0, h1] + +theorem Q_tangent_obstruction_zero {τ : E} (hτ : τ ≠ 0) (A : E →L[ℝ] E) + (h : ∀ v, obstruction (Q τ) ((QDeriv τ).comp A) v = 0) : + (QDeriv τ).comp A = 0 := by + have hρ := radiusSq_ne_zero hτ + have hk := kernel_of_obstruction_zero (Q τ) ((QDeriv τ).comp A) h + have hs := kernel_smul (Q τ) (derivativeArray ((QDeriv τ).comp A)) + (radiusSq τ) (radiusSq τ ^ 2) hk + have hc : radiusSq τ • Q τ = + ![τ 0 ^ 3, τ 0 ^ 2 * τ 1, τ 0 * τ 1 ^ 2, τ 1 ^ 3] := by + ext i + fin_cases i <;> simp [Q] <;> field_simp [hρ] + have hz : radiusSq τ ^ 2 • derivativeArray ((QDeriv τ).comp A) = + qTangentArray (τ 0) (τ 1) (traceDerivativeArray A) := by + ext i + fin_cases i <;> + norm_num [derivativeArray, qTangentArray, traceDerivativeArray, + QDeriv_apply, QNum, ContinuousLinearMap.comp_apply, Pi.smul_apply, smul_eq_mul] <;> + field_simp [hρ] <;> ring + rw [hc, hz] at hs + have hw := q_tangent_kernel (τ 0) (τ 1) (traceDerivativeArray A) hρ hs + rw [traceDerivativeArray_eq_zero A hw] + simp + +theorem R_tangent_obstruction_zero {τ : E} (hτ : τ ≠ 0) (A : E →L[ℝ] E) + (h : ∀ v, obstruction (R τ) ((RDeriv τ).comp A) v = 0) : + (RDeriv τ).comp A = 0 := by + have hρ := radiusSq_ne_zero hτ + have hk := kernel_of_obstruction_zero (R τ) ((RDeriv τ).comp A) h + have hs := kernel_smul (R τ) (derivativeArray ((RDeriv τ).comp A)) + (radiusSq τ) (radiusSq τ ^ 2) hk + have hc : radiusSq τ • R τ = + ![3 * τ 0 * τ 1 ^ 2, -2 * τ 0 ^ 2 * τ 1 + τ 1 ^ 3, + τ 0 ^ 3 - 2 * τ 0 * τ 1 ^ 2, 3 * τ 0 ^ 2 * τ 1] := by + ext i + fin_cases i <;> simp [R, Q] <;> field_simp [hρ] <;> simp [radiusSq] <;> ring_nf <;> simp + have hz : radiusSq τ ^ 2 • derivativeArray ((RDeriv τ).comp A) = + rTangentArray (τ 0) (τ 1) (traceDerivativeArray A) := by + ext i + fin_cases i <;> + norm_num [derivativeArray, rTangentArray, traceDerivativeArray, + RDeriv_apply hτ, RNum, ContinuousLinearMap.comp_apply, Pi.smul_apply, smul_eq_mul] <;> + field_simp [hρ] + rw [hc, hz] at hs + have hw := r_tangent_kernel (τ 0) (τ 1) (traceDerivativeArray A) hρ hs + rw [traceDerivativeArray_eq_zero A hw] + simp + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/TensorBounds.lean b/LeanPool/PlanarMidpoint/TensorBounds.lean new file mode 100644 index 0000000000..249ea7cb7a --- /dev/null +++ b/LeanPool/PlanarMidpoint/TensorBounds.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Basic +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +/-! Explicit operator bounds for the planar cubic tensor. -/ + +@[expose] public section +namespace PlanarMidpoint + +/-- The Euclidean norm is bounded by the sum of absolute coordinates. -/ +theorem norm_le_abs_coordinates (u : E) : ‖u‖ ≤ |u 0| + |u 1| := by + have he : ‖u‖ ^ 2 = (u 0) ^ 2 + (u 1) ^ 2 := by + simpa only [Fin.sum_univ_two] using EuclideanSpace.real_norm_sq_eq u + nlinarith [norm_nonneg u, abs_nonneg (u 0), abs_nonneg (u 1), + mul_nonneg (abs_nonneg (u 0)) (abs_nonneg (u 1)), sq_abs (u 0), sq_abs (u 1)] + +private theorem four_terms_bound (c : Coeff) (u v : E) (i j k : Fin 4) : + |c i * u 0 * v 0 + c j * (u 0 * v 1 + u 1 * v 0) + c k * u 1 * v 1| ≤ + 4 * ‖c‖ * ‖u‖ * ‖v‖ := by + have term (r : Fin 4) (s t : Fin 2) : + |c r * u s * v t| ≤ ‖c‖ * ‖u‖ * ‖v‖ := by + rw [abs_mul, abs_mul] + apply mul_le_mul + · apply mul_le_mul + · simpa only [Real.norm_eq_abs] using norm_le_pi_norm c r + · simpa only [Real.norm_eq_abs] using PiLp.norm_apply_le u s + · exact abs_nonneg _ + · exact norm_nonneg _ + · simpa only [Real.norm_eq_abs] using PiLp.norm_apply_le v t + · exact abs_nonneg _ + · exact mul_nonneg (norm_nonneg _) (norm_nonneg _) + have he : c i * u 0 * v 0 + c j * (u 0 * v 1 + u 1 * v 0) + c k * u 1 * v 1 = + c i * u 0 * v 0 + c j * u 0 * v 1 + c j * u 1 * v 0 + c k * u 1 * v 1 := by ring + rw [he] + have h1 := norm_add_le (c i * u 0 * v 0 + c j * u 0 * v 1 + c j * u 1 * v 0) (c k * u 1 * v 1) + have h2 := norm_add_le (c i * u 0 * v 0 + c j * u 0 * v 1) (c j * u 1 * v 0) + have h3 := norm_add_le (c i * u 0 * v 0) (c j * u 0 * v 1) + simp only [Real.norm_eq_abs] at h1 h2 h3 + linarith [term i 0 0, term j 0 1, term j 1 0, term k 1 1] + +/-- A uniform trilinear bound; the constant is deliberately coarse. -/ +theorem norm_K_le (c : Coeff) (u v : E) : + ‖K c u v‖ ≤ 8 * ‖c‖ * ‖u‖ * ‖v‖ := by + have h := norm_le_abs_coordinates (K c u v) + have h0 := four_terms_bound c u v 0 1 2 + have h1 := four_terms_bound c u v 1 2 3 + simp only [K, vec_zero, vec_one] at h + dsimp only [K] + linarith + + +/-- Difference decomposition retaining the quadratic velocity structure. -/ +theorem K_diagonal_sub (c d : Coeff) (v w : E) : + K c v v - K d w w = + K (c - d) v v + K d (v - w) v + K d w (v - w) := by + apply vec_ext <;> simp [K, Pi.sub_apply] <;> ring + +/-- The Christoffel force is locally Lipschitz in coefficients and velocity. -/ +theorem norm_K_diagonal_sub_le (c d : Coeff) (v w : E) : + ‖K c v v - K d w w‖ ≤ + 8 * ‖c - d‖ * ‖v‖ ^ 2 + 8 * ‖d‖ * (‖v‖ + ‖w‖) * ‖v - w‖ := by + rw [K_diagonal_sub] + calc + ‖K (c - d) v v + K d (v - w) v + K d w (v - w)‖ ≤ + ‖K (c - d) v v‖ + ‖K d (v - w) v‖ + ‖K d w (v - w)‖ := norm_add₃_le + _ ≤ 8 * ‖c - d‖ * ‖v‖ * ‖v‖ + 8 * ‖d‖ * ‖v - w‖ * ‖v‖ + 8 * ‖d‖ * ‖w‖ * ‖v - w‖ := + add_le_add (add_le_add (norm_K_le _ _ _) (norm_K_le _ _ _)) (norm_K_le _ _ _) + _ = _ := by ring + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/TensorSemantics.lean b/LeanPool/PlanarMidpoint/TensorSemantics.lean new file mode 100644 index 0000000000..197b56e1bf --- /dev/null +++ b/LeanPool/PlanarMidpoint/TensorSemantics.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import LeanPool.PlanarMidpoint.Coordinates +public import Mathlib.Analysis.Calculus.ContDiff.Operations +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring + +/-! +# Tensor semantics + +Every continuous symmetric trilinear form on the Euclidean plane is uniquely +represented by the four coefficients used in the obstruction calculation. +The trilinear form is curried into three continuous linear maps. +-/ + +@[expose] public section + +noncomputable section + +namespace PlanarMidpoint + +open scoped ContDiff + +/-- Continuous trilinear forms on the Euclidean plane, represented as curried maps. -/ +abbrev CubicTensor := E →L[ℝ] (E →L[ℝ] (E →L[ℝ] ℝ)) + +/-- Invariance of a trilinear form under the two adjacent transpositions. -/ +def IsTotallySymmetric (T : CubicTensor) : Prop := + (∀ u v w, T u v w = T v u w) ∧ (∀ u v w, T u v w = T u w v) + +/-- The four independent coordinate values of a symmetric planar cubic tensor. -/ +def tensorCoefficients (T : CubicTensor) : Coeff := + ![T (vec 1 0) (vec 1 0) (vec 1 0), T (vec 1 0) (vec 1 0) (vec 0 1), + T (vec 1 0) (vec 0 1) (vec 0 1), T (vec 0 1) (vec 0 1) (vec 0 1)] + +theorem tensor_eq_cubic (T : CubicTensor) (hT : IsTotallySymmetric T) (u v w : E) : + T u v w = cubic (tensorCoefficients T) u v w := by + have h100 := (hT.1 (vec 0 1) (vec 1 0) (vec 1 0)).trans + (hT.2 (vec 1 0) (vec 0 1) (vec 1 0)) + have h010 := hT.2 (vec 1 0) (vec 0 1) (vec 1 0) + have h101 := hT.1 (vec 0 1) (vec 1 0) (vec 0 1) + have h110 := (hT.2 (vec 0 1) (vec 0 1) (vec 1 0)).trans h101 + conv_lhs => rw [vec_decomp u, vec_decomp v, vec_decomp w] + simp only [map_add, map_smul, add_apply, smul_apply, smul_eq_mul] + simp only [h100, h010, h101, h110, cubic, tensorCoefficients, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val] + ring + +theorem symmetric_tensor_ext {T U : CubicTensor} + (hT : IsTotallySymmetric T) (hU : IsTotallySymmetric U) + (h : tensorCoefficients T = tensorCoefficients U) : T = U := by + ext u v w + rw [tensor_eq_cubic T hT, tensor_eq_cubic U hU, h] + +theorem contDiffAt_tensorCoefficients {A : Type*} [NormedAddCommGroup A] + [NormedSpace ℝ A] {n : ℕ∞ω} {T : A → CubicTensor} {p : A} + (hT : ∀ u v w, ContDiffAt ℝ n (fun x => T x u v w) p) : + ContDiffAt ℝ n (fun x => tensorCoefficients (T x)) p := by + apply contDiffAt_pi.mpr + intro i + fin_cases i <;> exact hT _ _ _ + +end PlanarMidpoint diff --git a/LeanPool/PlanarMidpoint/Topology.lean b/LeanPool/PlanarMidpoint/Topology.lean new file mode 100644 index 0000000000..003a9380cd --- /dev/null +++ b/LeanPool/PlanarMidpoint/Topology.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ +module + +public import Mathlib.Analysis.Calculus.MeanValue +public import Mathlib.Tactic.Continuity + +/-! +# Connected-domain closure and separated branches + +The closure argument only requires differentiability; derivatives need not +vary continuously and zero values are treated by open level sets. +-/ + +@[expose] public section + +open Set Metric + +namespace PlanarMidpoint + +variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + {s : Set E} {f : E → F} + +omit [NormedSpace ℝ E] [NormedSpace ℝ F] in +/-- A nonempty open fiber of a continuous function on a preconnected set +is the whole domain. The fiber is open in the ambient space. -/ +theorem is_const_of_isOpen_fiber (hs : IsPreconnected s) + (hf : ContinuousOn f s) {c : F} + (hopen : IsOpen (s ∩ f ⁻¹' {c})) + (hne : ∃ y ∈ s, f y = c) : ∀ x ∈ s, f x = c := by + obtain ⟨y, hy, hyc⟩ := hne + intro x hx + have h₂ := hf.comp_continuous continuous_subtype_val (fun x ↦ x.2) + by_contra h₃ + obtain ⟨t, ht, ht'⟩ := (isClosed_singleton (x := c)).preimage h₂ + have ht'' : ∀ a ∈ s, a ∈ t ↔ f a ≠ c := by + simpa [Set.ext_iff] using ht' + obtain ⟨z, H₁, H₂, H₃⟩ := hs _ _ hopen ht + (fun x h ↦ by simp [h, ht'', eq_or_ne]) + ⟨y, by simpa [hyc]⟩ ⟨x, by simp [ht'' _ hx, hx, h₃]⟩ + exact (ht'' _ H₁).mp H₃ H₂.2 + +/-- Derivative zero away from the zero fiber already forces constancy. +This needs no continuity of the derivative and makes no assertion about +passing derivatives across the boundary of the zero fiber. -/ +theorem exists_is_const_of_fderiv_eq_zero_off_zero + (hs : IsOpen s) (hconn : IsPreconnected s) + (hf : DifferentiableOn ℝ f s) + (hzero : ∀ x ∈ s, f x ≠ 0 → fderiv ℝ f x = 0) : + ∃ c, ∀ x ∈ s, f x = c := by + by_cases hn : ∃ y ∈ s, f y ≠ 0 + · obtain ⟨y, hy, hny⟩ := hn + refine ⟨f y, is_const_of_isOpen_fiber hconn hf.continuousOn ?_ ⟨y, hy, rfl⟩⟩ + let u := s ∩ f ⁻¹' ({0}ᶜ : Set F) + have hu : IsOpen u := hf.continuousOn.isOpen_inter_preimage hs isOpen_compl_singleton + have hfu : DifferentiableOn ℝ f u := hf.mono inter_subset_left + have hzu : u.EqOn (fderiv ℝ f) 0 := fun x hx ↦ hzero x hx.1 hx.2 + have hv := hu.isOpen_inter_preimage_of_fderiv_eq_zero hfu hzu {f y} + have heq : u ∩ f ⁻¹' {f y} = s ∩ f ⁻¹' {f y} := by + ext x + simp only [u, mem_inter_iff, mem_preimage, mem_compl_iff, mem_singleton_iff] + constructor + · exact fun h ↦ ⟨h.1.1, h.2⟩ + · exact fun h ↦ ⟨⟨h.1, h.2 ▸ hny⟩, h.2⟩ + rwa [heq] at hv + · refine ⟨0, fun x hx ↦ ?_⟩ + by_contra h + exact hn ⟨x, hx, h⟩ + +/-- Two-stage closure for a differential rigidity argument. An attained +value in an open regular locus propagates through a clopen fiber. If the +regular locus is never attained, the exceptional-locus argument only needs +to prove vanishing at nonzero values. -/ +theorem exists_is_const_of_regular_locus + (hs : IsOpen s) (hconn : IsPreconnected s) + (hf : DifferentiableOn ℝ f s) + (G : Set F) (hG : IsOpen G) + (hregular : ∀ x ∈ s, f x ∈ G → fderiv ℝ f x = 0) + (hexceptional : (∀ x ∈ s, f x ∉ G) → + ∀ x ∈ s, f x ≠ 0 → fderiv ℝ f x = 0) : + ∃ c, ∀ x ∈ s, f x = c := by + by_cases hn : ∃ y ∈ s, f y ∈ G + · obtain ⟨y, hy, hGy⟩ := hn + refine ⟨f y, is_const_of_isOpen_fiber hconn hf.continuousOn ?_ ⟨y, hy, rfl⟩⟩ + let u := s ∩ f ⁻¹' G + have hu : IsOpen u := hf.continuousOn.isOpen_inter_preimage hs hG + have hfu : DifferentiableOn ℝ f u := hf.mono inter_subset_left + have hzu : u.EqOn (fderiv ℝ f) 0 := fun x hx ↦ hregular x hx.1 hx.2 + have hv := hu.isOpen_inter_preimage_of_fderiv_eq_zero hfu hzu {f y} + have heq : u ∩ f ⁻¹' {f y} = s ∩ f ⁻¹' {f y} := by + ext x + simp only [u, mem_inter_iff, mem_preimage, mem_singleton_iff] + constructor + · exact fun h ↦ ⟨h.1.1, h.2⟩ + · exact fun h ↦ ⟨⟨h.1, h.2 ▸ hGy⟩, h.2⟩ + rwa [heq] at hv + · apply exists_is_const_of_fderiv_eq_zero_off_zero hs hconn hf + apply hexceptional + intro x hx hGx + exact hn ⟨x, hx, hGx⟩ + +omit [NormedSpace ℝ E] [NormedSpace ℝ F] in +/-- Two separated continuous branches cannot switch arbitrarily close to a point. +The branch classification must hold throughout a neighborhood before this +lemma can be used to identify derivatives. -/ +theorem eventually_eq_left_branch {g h : E → F} {x : E} + (hf : ContinuousAt f x) (hh : ContinuousAt h x) + (hsep : g x ≠ h x) (hfg : f x = g x) + (hbranches : ∀ᶠ y in nhds x, f y = g y ∨ f y = h y) : + f =ᶠ[nhds x] g := by + have hne : f x ≠ h x := hfg ▸ hsep + filter_upwards [(hf.ne_iff_eventually_ne hh).mp hne, hbranches] with y hy hcase + exact hcase.resolve_right hy + +/-- Local equality with a selected branch identifies the full Fréchet derivative. -/ +theorem fderiv_eq_left_branch {g h : E → F} {x : E} + (hf : ContinuousAt f x) (hh : ContinuousAt h x) + (hsep : g x ≠ h x) (hfg : f x = g x) + (hbranches : ∀ᶠ y in nhds x, f y = g y ∨ f y = h y) : + fderiv ℝ f x = fderiv ℝ g x := + (eventually_eq_left_branch hf hh hsep hfg hbranches).fderiv_eq + +end PlanarMidpoint diff --git a/LeanPool/projects/planar-midpoint-rigidity.yaml b/LeanPool/projects/planar-midpoint-rigidity.yaml new file mode 100644 index 0000000000..ea0f1df78c --- /dev/null +++ b/LeanPool/projects/planar-midpoint-rigidity.yaml @@ -0,0 +1,50 @@ +slug: planar-midpoint-rigidity +title: Planar Euclidean dual-geodesic midpoint rigidity +entry_module: LeanPool.PlanarMidpoint +authors: + - JD Jones +source: + github_repo: JD-Jones-ASES/PlanarMidpoint + url: https://github.com/JD-Jones-ASES/PlanarMidpoint/tree/f277b89a3b0db20872101fd61580ecced748e7c1 + arxiv: "2609.07551" + notes: >- + The upstream MIT-licensed original proof settles the dimension-two case of + Nielsen–Okamura Conjecture 9.1 (v2, Section 9); the cited paper poses the + general-dimensional conjecture and does not contain this planar necessity proof. + Public completed source was released on 2026-10-08. Proofs and mathematical + arguments were produced by OpenAI Codex agents under JD Jones's supervision. +license: MIT +status: verified +provenance: AI +summary: >- + Complementary canonical local midpoints for two Euclidean dual torsion-free + connections force their symmetric cubic tensor to be constant on a connected + open planar domain. The proof constructs the local geodesic germs and derives + the fourth-order obstruction, including its exceptional tensors. A differential + strengthening needs only differentiability; five fixed direction tests suffice. +branch: Differential geometry +main_declarations: + - PlanarMidpoint.planar_dual_midpoint_rigidity +main_results: + - declaration: PlanarMidpoint.planar_dual_midpoint_rigidity + informal: >- + On an open preconnected Euclidean planar domain, a smooth symmetric cubic + tensor field whose canonical local dual geodesic midpoints sum to the + endpoints is constant. + - declaration: PlanarMidpoint.planar_midpoint_rigidity_C2 + informal: The geometric midpoint rigidity theorem already holds for C2 coefficient fields. + - declaration: PlanarMidpoint.planar_obstruction_rigidity + informal: >- + A differentiable planar cubic coefficient field is constant if its quartic + midpoint obstruction vanishes at every point and in every direction. + - declaration: PlanarMidpoint.planar_five_direction_rigidity + informal: >- + The differential obstruction criterion needs only the five directions + (j, 1) for j = 0, 1, 2, 3, 4 at every point. +tags: + - differential-geometry + - ordinary-differential-equations + - functional-equations +msc: + - 53B12 + - 39B22