diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c59a4fb..024daa5 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -73,6 +73,31 @@ jobs: - name: Fail if the regenerated files differ from the committed ones run: git diff --exit-code CompElliptic/Fields/Pasta.lean CompElliptic/Fields/Jubjub.lean + velu-certificates: + name: Vélu certificates reproduce + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 + with: + persist-credentials: false + # Sage pinned to the version that generated the committed certificates: + # Singular's `lift` output (the emitted cofactors) can differ between + # versions, so byte-reproducibility needs the same engine as the local + # regeneration. + - uses: mamba-org/setup-micromamba@f457c30a868e4760d3a6fcea5f25dc655b8edf39 # v3.2.1 + with: + environment-name: sage + condarc: | + channels: + - conda-forge + create-args: sage=10.9 + cache-environment: true + - name: Regenerate the certificate section + shell: bash -el {0} + run: sage scripts/gen_velu_certificates.sage + - name: Fail if the regenerated section differs from the committed one + run: git diff --exit-code CompElliptic/Isogenies/VeluCertificates.lean + native-lane: name: FastFieldNative lane is core-only runs-on: ubuntu-latest diff --git a/CompElliptic.lean b/CompElliptic.lean index c668161..47774e4 100644 --- a/CompElliptic.lean +++ b/CompElliptic.lean @@ -15,6 +15,14 @@ import CompElliptic.Fields.Residue import CompElliptic.Fields.Sqrt import CompElliptic.CurveForms.ShortWeierstrass import CompElliptic.CurveOrder +import CompElliptic.Isogenies.ThreeIsogeny import CompElliptic.Curves.Pasta +import CompElliptic.Curves.IsoPasta import CompElliptic.Curves.PastaOrder +import CompElliptic.Hashing.CharacterSum +import CompElliptic.Hashing.PastaSSWU +import CompElliptic.Hashing.SignedLift +import CompElliptic.Hashing.SimplifiedSWU +import CompElliptic.Hashing.TwoTermUniformity +import CompElliptic.Hashing.WellDistributed import CompElliptic.TrustBoundary diff --git a/CompElliptic/Curves/IsoPasta.lean b/CompElliptic/Curves/IsoPasta.lean new file mode 100644 index 0000000..66557e5 --- /dev/null +++ b/CompElliptic/Curves/IsoPasta.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Curves.Pasta +import CompElliptic.Isogenies.ThreeIsogeny + +/-! +# The iso-Pasta curves and their isogenies to Pallas and Vesta + +Simplified SWU needs a curve coefficient `A ≠ 0`, and both Pasta curves have `A = 0`, +so hashing to them goes through auxiliary curves: iso-Pallas and iso-Vesta, each +3-isogenous to its target. The curves and their isogeny maps are specified in +§5.4.9.8 of the Zcash protocol specification (`iso_map`); the same constants appear, +in decimal, in `zcash/pasta`'s `hashtocurve.sage`. (`amicable.sage` originally found +the curves with Sage's `isogenies_prime_degree(3)`, and the maps are the isogenies' +affine `rational_maps()`.) + +Each isogeny is stated twice here, and that is the point of the design: + +* `Pallas.iso` (and `Vesta.iso`) is the `ThreeIsogeny` *derivation* of the map — the + kernel abscissa `x₀` and normalizing scalar `s`, recovered from the specified + coefficients (`x₀ = -b₁/2` from the abscissa denominator, `s` from the leading + coefficients), with Vélu's formulae supplying the rational maps and the codomain. + Its obligations are numeral checks (`ψ₃(x₀) = 0`, the codomain equations) together + with the kernel's irrationality: both kernel ordinates satisfy `y₀² = 5`, so that + is exactly `five_not_isSquare` — the same nonsquare that already pins `x = 0` off + both curves. +* `Pallas.iso_map` (and `Vesta.iso_map`) is the specified map: its constants + `CP_1, ..., CP_13` (`CV_*` for Vesta) quote the hex list of §5.4.9.8 verbatim, and + those agree with the decimal constants of `hashtocurve.sage`. `iso_map_eq` proves + the map equal to the derivation. The general theorems of `ThreeIsogeny` — totality + on rational points, landing on the target curve, oddness — then apply to the + deployed constants; `onCurve_iso_map` states the on-curve consequence directly. +-/ + +open CompElliptic.CurveForms.ShortWeierstrass CompElliptic.Fields.Pasta +open CompElliptic.Isogenies + +namespace CompElliptic.Curves.Pasta + +namespace Pallas + +/-- The auxiliary curve 3-isogenous to Pallas ("iso-Pallas"): `y² = x³ + A'·x + 1265` +over the Pallas base field, with `A' ≠ 0` as simplified SWU requires. -/ +def isoCurve : SWCurve PallasBaseField where + A := 0x18354a2eb0ea8c9c49be2d7258370742b74134581a27a59f92bb4b0b657a014b + B := 1265 + IsElliptic := by rw [isUnit_iff_ne_zero]; decide + B_nonzero := by decide + +/-- The degree-3 isogeny iso-Pallas → Pallas, as its Vélu derivation. -/ +def iso : ThreeIsogeny PallasBaseField where + domain := isoCurve + codomain := curve + x₀ := 7838456566140329779539982655430940346658055915816802388238595436199677105265 + s := 19298681539552699237261830834781317975575370987961040477303117842899978420225 + s_nonzero := by decide + psi3 := by decide + kernel_irrational := by + have h : (7838456566140329779539982655430940346658055915816802388238595436199677105265 : + PallasBaseField)^3 + + isoCurve.A * 7838456566140329779539982655430940346658055915816802388238595436199677105265 + + isoCurve.B = 5 := by decide + rw [h] + exact five_not_isSquare + codomain_A := by decide + codomain_B := by decide + +/-! The thirteen constants of the isogeny map, quoted in hex from the list +`IsoConst` for Pallas in §5.4.9.8 of the protocol specification (decimal in +`hashtocurve.sage`; the two sources agree). -/ + +def CP_1 : PallasBaseField := 0x0e38e38e38e38e38e38e38e38e38e38e4081775473d8375b775f6034aaaaaaab +def CP_2 : PallasBaseField := 0x3509afd51872d88e267c7ffa51cf412a0f93b82ee4b994958cf863b02814fb76 +def CP_3 : PallasBaseField := 0x17329b9ec525375398c7d7ac3d98fd13380af066cfeb6d690eb64faef37ea4f7 +def CP_4 : PallasBaseField := 0x1c71c71c71c71c71c71c71c71c71c71c8102eea8e7b06eb6eebec06955555580 +def CP_5 : PallasBaseField := 0x1d572e7ddc099cff5a607fcce0494a799c434ac1c96b6980c47f2ab668bcd71f +def CP_6 : PallasBaseField := 0x325669becaecd5d11d13bf2a7f22b105b4abf9fb9a1fc81c2aa3af1eae5b6604 +def CP_7 : PallasBaseField := 0x1a12f684bda12f684bda12f684bda12f7642b01ad461bad25ad985b5e38e38e4 +def CP_8 : PallasBaseField := 0x1a84d7ea8c396c47133e3ffd28e7a09507c9dc17725cca4ac67c31d8140a7dbb +def CP_9 : PallasBaseField := 0x3fb98ff0d2ddcadd303216cce1db9ff11765e924f745937802e2be87d225b234 +def CP_10 : PallasBaseField := 0x025ed097b425ed097b425ed097b425ed0ac03e8e134eb3e493e53ab371c71c4f +def CP_11 : PallasBaseField := 0x0c02c5bcca0e6b7f0790bfb3506defb65941a3a4a97aa1b35a28279b1d1b42ae +def CP_12 : PallasBaseField := 0x17033d3c60c68173573b3d7f7d681310d976bbfabbc5661d4d90ab820b12320a +def CP_13 : PallasBaseField := 0x40000000000000000000000000000000224698fc094cf91b992d30ecfffffde5 + +/-- The specified map iso-Pallas → Pallas, arranged as in §5.4.9.8. -/ +def iso_map (x y : PallasBaseField) : PallasBaseField × PallasBaseField := + ((CP_1 * x^3 + CP_2 * x^2 + CP_3 * x + CP_4) / (x^2 + CP_5 * x + CP_6), + (CP_7 * x^3 + CP_8 * x^2 + CP_9 * x + CP_10) * y / (x^3 + CP_11 * x^2 + CP_12 * x + CP_13)) + +/-- The specified coefficients are exactly what the Vélu derivation yields: each +coefficient is a numeral identity (`decide`), and the four polynomial identities +assemble by `linear_combination`. -/ +theorem iso_map_eq (x y : PallasBaseField) : iso_map x y = iso.mapXY x y := by + have hs : iso.s + = (19298681539552699237261830834781317975575370987961040477303117842899978420225 : + PallasBaseField) := rfl + have hx0 : iso.x₀ + = (7838456566140329779539982655430940346658055915816802388238595436199677105265 : + PallasBaseField) := rfl + have hA : iso.domain.A + = (10949663248450308183708987909873589833737836120165333298109615750520499732811 : + PallasBaseField) := rfl + have hB : iso.domain.B = (1265 : PallasBaseField) := rfl + simp only [iso_map, ThreeIsogeny.mapXY, ThreeIsogeny.xnum, ThreeIsogeny.ynum, + ThreeIsogeny.v, ThreeIsogeny.u, hs, hx0, hA, hB, Prod.mk.injEq] + set s : PallasBaseField := + 19298681539552699237261830834781317975575370987961040477303117842899978420225 with hsdef + set x₀ : PallasBaseField := + 7838456566140329779539982655430940346658055915816802388238595436199677105265 with hx0def + set A : PallasBaseField := + 10949663248450308183708987909873589833737836120165333298109615750520499732811 with hAdef + refine ⟨?_, ?_⟩ + · have e3 : CP_1 = s^2 := by rw [hsdef]; decide + have e2 : CP_2 = s^2 * (-2 * x₀) := by rw [hsdef, hx0def]; decide + have e1 : CP_3 = s^2 * (x₀^2 + 2 * (3 * x₀^2 + A)) := by + rw [hsdef, hx0def, hAdef]; decide + have e0 : CP_4 = s^2 * (4 * (x₀^3 + A * x₀ + 1265) - 2 * (3 * x₀^2 + A) * x₀) := by + rw [hsdef, hx0def, hAdef]; decide + have f1 : CP_5 = -2 * x₀ := by rw [hx0def]; decide + have f0 : CP_6 = x₀^2 := by rw [hx0def]; decide + rw [show (x^2 + CP_5 * x + CP_6 : PallasBaseField) = (x - x₀)^2 + from by linear_combination x * f1 + f0, + show (CP_1 * x^3 + CP_2 * x^2 + CP_3 * x + CP_4 : PallasBaseField) + = s^2 * (x * (x - x₀)^2 + 2 * (3 * x₀^2 + A) * (x - x₀) + + 4 * (x₀^3 + A * x₀ + 1265)) + from by linear_combination x^3 * e3 + x^2 * e2 + x * e1 + e0] + · have g3 : CP_7 = s^3 := by rw [hsdef]; decide + have g2 : CP_8 = s^3 * (-3 * x₀) := by rw [hsdef, hx0def]; decide + have g1 : CP_9 = s^3 * (3 * x₀^2 - 2 * (3 * x₀^2 + A)) := by + rw [hsdef, hx0def, hAdef]; decide + have g0 : CP_10 + = s^3 * (-x₀^3 + 2 * (3 * x₀^2 + A) * x₀ - 2 * (4 * (x₀^3 + A * x₀ + 1265))) := by + rw [hsdef, hx0def, hAdef]; decide + have k2 : CP_11 = -3 * x₀ := by rw [hx0def]; decide + have k1 : CP_12 = 3 * x₀^2 := by rw [hx0def]; decide + have k0 : CP_13 = -x₀^3 := by rw [hx0def]; decide + rw [show (x^3 + CP_11 * x^2 + CP_12 * x + CP_13 : PallasBaseField) = (x - x₀)^3 + from by linear_combination x^2 * k2 + x * k1 + k0, + show (CP_7 * x^3 + CP_8 * x^2 + CP_9 * x + CP_10 : PallasBaseField) + = s^3 * ((x - x₀)^3 - 2 * (3 * x₀^2 + A) * (x - x₀) + - 2 * (4 * (x₀^3 + A * x₀ + 1265))) + from by linear_combination x^3 * g3 + x^2 * g2 + x * g1 + g0] + ring + +/-- Points of iso-Pallas land on Pallas under the specified map. -/ +theorem onCurve_iso_map {x y : PallasBaseField} + (h : OnCurve isoCurve.A isoCurve.B (x, y)) : OnCurve a b (iso_map x y) := by + rw [iso_map_eq] + exact iso.onCurve_mapXY h + +end Pallas + +namespace Vesta + +/-- The auxiliary curve 3-isogenous to Vesta ("iso-Vesta"): `y² = x³ + A'·x + 1265` +over the Vesta base field, with `A' ≠ 0` as simplified SWU requires. -/ +def isoCurve : SWCurve VestaBaseField where + A := 0x267f9b2ee592271a81639c4d96f787739673928c7d01b212c515ad7242eaa6b1 + B := 1265 + IsElliptic := by rw [isUnit_iff_ne_zero]; decide + B_nonzero := by decide + +/-- The degree-3 isogeny iso-Vesta → Vesta, as its Vélu derivation. -/ +def iso : ThreeIsogeny VestaBaseField where + domain := isoCurve + codomain := curve + x₀ := 12171904256315698649025652314226635480811313718585433996597634167523473567372 + s := 19298681539552699237261830834781317975575370987961098253119828498928908632065 + s_nonzero := by decide + psi3 := by decide + kernel_irrational := by + have h : (12171904256315698649025652314226635480811313718585433996597634167523473567372 : + VestaBaseField)^3 + + isoCurve.A * 12171904256315698649025652314226635480811313718585433996597634167523473567372 + + isoCurve.B = 5 := by decide + rw [h] + exact five_not_isSquare + codomain_A := by decide + codomain_B := by decide + +/-! The thirteen constants of the isogeny map, quoted in hex from the list +`IsoConst` for Vesta in §5.4.9.8 of the protocol specification (decimal in +`hashtocurve.sage`; the two sources agree). -/ + +def CV_1 : VestaBaseField := 0x38e38e38e38e38e38e38e38e38e38e390205dd51cfa0961a43cd42c800000001 +def CV_2 : VestaBaseField := 0x1d935247b4473d17acecf10f5f7c09a2216b8861ec72bd5d8b95c6aaf703bcc5 +def CV_3 : VestaBaseField := 0x18760c7f7a9ad20ded7ee4a9cdf78f8fd59d03d23b39cb11aeac67bbeb586a3d +def CV_4 : VestaBaseField := 0x31c71c71c71c71c71c71c71c71c71c71e1c521a795ac8356fb539a6f0000002b +def CV_5 : VestaBaseField := 0x0a2de485568125d51454798a5b5c56b2a3ad678129b604d3b7284f7eaf21a2e9 +def CV_6 : VestaBaseField := 0x14735171ee5427780c621de8b91c242a30cd6d53df49d235f169c187d2533465 +def CV_7 : VestaBaseField := 0x12f684bda12f684bda12f684bda12f685601f4709a8adcb36bef1642aaaaaaab +def CV_8 : VestaBaseField := 0x2ec9a923da239e8bd6767887afbe04d121d910aefb03b31d8bee58e5fb81de63 +def CV_9 : VestaBaseField := 0x19b0d87e16e2578866d1466e9de10e6497a3ca5c24e9ea634986913ab4443034 +def CV_10 : VestaBaseField := 0x1ed097b425ed097b425ed097b425ed098bc32d36fb21a6a38f64842c55555533 +def CV_11 : VestaBaseField := 0x2f44d6c801c1b8bf9e7eb64f890a820c06a767bfc35b5bac58dfecce86b2745e +def CV_12 : VestaBaseField := 0x3d59f455cafc7668252659ba2b546c7e926847fb9ddd76a1d43d449776f99d2f +def CV_13 : VestaBaseField := 0x40000000000000000000000000000000224698fc0994a8dd8c46eb20fffffde5 + +/-- The specified map iso-Vesta → Vesta, arranged as in §5.4.9.8. -/ +def iso_map (x y : VestaBaseField) : VestaBaseField × VestaBaseField := + ((CV_1 * x^3 + CV_2 * x^2 + CV_3 * x + CV_4) / (x^2 + CV_5 * x + CV_6), + (CV_7 * x^3 + CV_8 * x^2 + CV_9 * x + CV_10) * y / (x^3 + CV_11 * x^2 + CV_12 * x + CV_13)) + +/-- The specified coefficients are exactly what the Vélu derivation yields: each +coefficient is a numeral identity (`decide`), and the four polynomial identities +assemble by `linear_combination`. -/ +theorem iso_map_eq (x y : VestaBaseField) : iso_map x y = iso.mapXY x y := by + have hs : iso.s + = (19298681539552699237261830834781317975575370987961098253119828498928908632065 : + VestaBaseField) := rfl + have hx0 : iso.x₀ + = (12171904256315698649025652314226635480811313718585433996597634167523473567372 : + VestaBaseField) := rfl + have hA : iso.domain.A + = (17413348858408915339762682399132325137863850198379221683097628341577494210225 : + VestaBaseField) := rfl + have hB : iso.domain.B = (1265 : VestaBaseField) := rfl + simp only [iso_map, ThreeIsogeny.mapXY, ThreeIsogeny.xnum, ThreeIsogeny.ynum, + ThreeIsogeny.v, ThreeIsogeny.u, hs, hx0, hA, hB, Prod.mk.injEq] + set s : VestaBaseField := + 19298681539552699237261830834781317975575370987961098253119828498928908632065 with hsdef + set x₀ : VestaBaseField := + 12171904256315698649025652314226635480811313718585433996597634167523473567372 with hx0def + set A : VestaBaseField := + 17413348858408915339762682399132325137863850198379221683097628341577494210225 with hAdef + refine ⟨?_, ?_⟩ + · have e3 : CV_1 = s^2 := by rw [hsdef]; decide + have e2 : CV_2 = s^2 * (-2 * x₀) := by rw [hsdef, hx0def]; decide + have e1 : CV_3 = s^2 * (x₀^2 + 2 * (3 * x₀^2 + A)) := by + rw [hsdef, hx0def, hAdef]; decide + have e0 : CV_4 = s^2 * (4 * (x₀^3 + A * x₀ + 1265) - 2 * (3 * x₀^2 + A) * x₀) := by + rw [hsdef, hx0def, hAdef]; decide + have f1 : CV_5 = -2 * x₀ := by rw [hx0def]; decide + have f0 : CV_6 = x₀^2 := by rw [hx0def]; decide + rw [show (x^2 + CV_5 * x + CV_6 : VestaBaseField) = (x - x₀)^2 + from by linear_combination x * f1 + f0, + show (CV_1 * x^3 + CV_2 * x^2 + CV_3 * x + CV_4 : VestaBaseField) + = s^2 * (x * (x - x₀)^2 + 2 * (3 * x₀^2 + A) * (x - x₀) + + 4 * (x₀^3 + A * x₀ + 1265)) + from by linear_combination x^3 * e3 + x^2 * e2 + x * e1 + e0] + · have g3 : CV_7 = s^3 := by rw [hsdef]; decide + have g2 : CV_8 = s^3 * (-3 * x₀) := by rw [hsdef, hx0def]; decide + have g1 : CV_9 = s^3 * (3 * x₀^2 - 2 * (3 * x₀^2 + A)) := by + rw [hsdef, hx0def, hAdef]; decide + have g0 : CV_10 + = s^3 * (-x₀^3 + 2 * (3 * x₀^2 + A) * x₀ - 2 * (4 * (x₀^3 + A * x₀ + 1265))) := by + rw [hsdef, hx0def, hAdef]; decide + have k2 : CV_11 = -3 * x₀ := by rw [hx0def]; decide + have k1 : CV_12 = 3 * x₀^2 := by rw [hx0def]; decide + have k0 : CV_13 = -x₀^3 := by rw [hx0def]; decide + rw [show (x^3 + CV_11 * x^2 + CV_12 * x + CV_13 : VestaBaseField) = (x - x₀)^3 + from by linear_combination x^2 * k2 + x * k1 + k0, + show (CV_7 * x^3 + CV_8 * x^2 + CV_9 * x + CV_10 : VestaBaseField) + = s^3 * ((x - x₀)^3 - 2 * (3 * x₀^2 + A) * (x - x₀) + - 2 * (4 * (x₀^3 + A * x₀ + 1265))) + from by linear_combination x^3 * g3 + x^2 * g2 + x * g1 + g0] + ring + +/-- Points of iso-Vesta land on Vesta under the specified map. -/ +theorem onCurve_iso_map {x y : VestaBaseField} + (h : OnCurve isoCurve.A isoCurve.B (x, y)) : OnCurve a b (iso_map x y) := by + rw [iso_map_eq] + exact iso.onCurve_mapXY h + +end Vesta + +end CompElliptic.Curves.Pasta diff --git a/CompElliptic/Curves/Pasta.lean b/CompElliptic/Curves/Pasta.lean index fd6caf1..802ea5f 100644 --- a/CompElliptic/Curves/Pasta.lean +++ b/CompElliptic/Curves/Pasta.lean @@ -67,6 +67,29 @@ theorem no_onCurve_x_zero (y : PallasBaseField) : ¬ OnCurve a b (0, y) := by have h' : y ^ 2 = 5 := by simpa [OnCurve, a, b] using h exact five_not_isSquare ⟨y, by rw [← h', pow_two]⟩ +/-- `-5` is not a cube in the Pallas base field — the cubic analogue of `five_not_isSquare`, and +what rules out 2-torsion on the Pallas curve. + +`3 ∣ p - 1`, so `not_exists_pow_eq_of_pow_ne_one` reduces this to the single power +`(-5)^((p-1)/3)`, which is not `1`. As for `five_not_isSquare`, `reduce_mod_char` (fast modular +exponentiation) evaluates it and the kernel re-checks the result. -/ +theorem neg_five_not_isCube : ¬ ∃ x : PallasBaseField, x ^ 3 = -(5 : PallasBaseField) := by + have hcard : Fintype.card PallasBaseField = PALLAS_BASE_CARD := ZMod.card _ + refine Fields.not_exists_pow_eq_of_pow_ne_one (n := 3) (by rw [hcard]; decide) (by decide) ?_ + rw [hcard] + -- `reduce_mod_char` keys on the `ZMod` spelling of the type, which the `PallasBaseField` abbrev + -- hides; `show` re-exposes it. + show (-(5 : ZMod PALLAS_BASE_CARD)) ^ ((PALLAS_BASE_CARD - 1) / 3) ≠ 1 + reduce_mod_char + decide + +/-- No point on the Pallas curve has `y`-coordinate `0`: that would need `x³ = -5`, and `-5` is +not a cube (`neg_five_not_isCube`). Equivalently, the Pallas group has no 2-torsion. -/ +theorem no_onCurve_y_zero (x : PallasBaseField) : ¬ OnCurve a b (x, 0) := by + intro h + have hsum : x ^ 3 + 5 = 0 := by simpa [OnCurve, a, b] using h.symm + exact neg_five_not_isCube ⟨x, by linear_combination hsum⟩ + -- `(-1, 2)` is on the curve: `2² = 4 = (-1)³ + 5`. example : OnCurve a b G := by native_decide diff --git a/CompElliptic/Curves/PastaOrder.lean b/CompElliptic/Curves/PastaOrder.lean index 9d08407..f2bf023 100644 --- a/CompElliptic/Curves/PastaOrder.lean +++ b/CompElliptic/Curves/PastaOrder.lean @@ -5,14 +5,19 @@ as described in the files LICENSE-APACHE and LICENSE-MIT. Authors: Daira-Emma Hopwood, Gregor Mitscha-Baude -/ import CompElliptic.Curves.Pasta +import CompElliptic.Curves.IsoPasta import CompElliptic.CurveOrder +import CompElliptic.Isogenies.Homomorphism /-! -# Orders of the Pasta curve groups (Pallas and Vesta) +# Orders of the Pasta and iso-Pasta curve groups -Instantiates the `CompElliptic.CurveOrder` fibre bound at the two Pasta curves, with no assumption: -the Pallas group has order `PALLAS_SCALAR_CARD` and the Vesta group has order `PALLAS_BASE_CARD` -(the Pasta cycle: each curve's order is the other's base-field size). +Instantiates the `CompElliptic.CurveOrder` fibre bound at the two Pasta curves and their +3-isogenous auxiliaries, with no assumption: the Pallas and iso-Pallas groups have order +`PALLAS_SCALAR_CARD`, and the Vesta and iso-Vesta groups have order `PALLAS_BASE_CARD` +(the Pasta cycle: each curve's order is the other's base-field size; isogenous curves have +equal orders, though here each order is pinned by its own witness rather than by the +isogeny). The test point `G = (-1, 2)` is the prime-order witness, and the witness fact `[order] G = 𝒪` (a `≈ 2^254` scalar multiplication) is a one-line `native_decide` now that the `SWPoint` scalar @@ -26,6 +31,17 @@ of the two field sizes, and the Pasta cycle puts the two curves on opposite side `2q + 1 < 3p` is available. `#E = 2p` is ruled out separately: a 2-torsion point needs `y = 0`, i.e. `x³ = -5`, which `Pasta.Vesta.no_onCurve_y_zero` forbids. +With the orders in hand, each isogeny's injectivity upgrades to bijectivity on rational +points by counting (`iso_map_bijective`). Injectivity is `ThreeIsogeny.map_injective`: an +abscissa collision would exhibit the nonsquare `y₀²` as a square, contradicting the +kernel's irrationality. No homomorphism property is consumed. + +The iso-curves take the same two routes as their targets. The one new ingredient is +iso-Vesta's 2-torsion exclusion: its curve cubic has a linear term, so the cube-residue +argument does not apply, but none is needed — a `y = 0` point of iso-Vesta would map to a +`y = 0` point of Vesta under the isogeny (`ThreeIsogeny.no_y_zero_of_codomain`), and Vesta +has none. + Per the *Independently re-checkable trust* principle every obligation here is a closed numeric fact (`2p + 1 < 2q`, `2q + 1 < 3p`), discharged by kernel `decide`; the only trust is the prime-order witnesses (`q_nsmul_Gpt`, `p_nsmul_Gpt`), proved by `native_decide` and appearing in `#print axioms` @@ -56,6 +72,43 @@ theorem card_eq : Nat.card (SWPoint curve) = PALLAS_SCALAR_CARD := by rw [show Fintype.card PallasBaseField = PALLAS_BASE_CARD from ZMod.card _] decide +/-- A prime-order witness on iso-Pallas, at the smallest square abscissa `x = 1`. -/ +def isoGpt : SWPoint isoCurve := + ⟨1, 181637241052482785468502922954224147219384682169221362737776065992881747347, + Or.inl (by decide)⟩ + +theorem isoGpt_ne_zero : isoGpt ≠ 0 := by decide + +/-- `[q] G = 𝒪` on iso-Pallas, where `q = PALLAS_SCALAR_CARD` is the iso-Pallas group order. -/ +theorem q_nsmul_isoGpt : PALLAS_SCALAR_CARD • isoGpt = 0 := by native_decide + +/-- **The iso-Pallas curve group has order `PALLAS_SCALAR_CARD`**, unconditionally — the same +order as Pallas, by the same route. -/ +theorem iso_card_eq : Nat.card (SWPoint isoCurve) = PALLAS_SCALAR_CARD := by + refine card_eq_of_prime_witness_of_card_lt_two_mul isoCurve PALLAS_SCALAR_is_prime + isoGpt_ne_zero q_nsmul_isoGpt ?_ + rw [show Fintype.card PallasBaseField = PALLAS_BASE_CARD from ZMod.card _] + decide + +/-- The isogeny iso-Pallas → Pallas is a bijection on rational points, by counting: it is +injective with no homomorphism property consumed (`ThreeIsogeny.map_injective`), and the +two groups have the same order. -/ +theorem iso_map_bijective : Function.Bijective iso.map := + iso.map_bijective (by decide) no_onCurve_y_zero (iso_card_eq.trans card_eq.symm) + + +/-- No point of iso-Pallas has `y = 0`: such a point would map to a `y = 0` point of +Pallas under the isogeny, and Pallas has none. -/ +theorem iso_no_onCurve_y_zero (x : PallasBaseField) : + ¬ OnCurve isoCurve.A isoCurve.B (x, 0) := + iso.no_y_zero_of_codomain no_onCurve_y_zero x + +/-- **The deployed Pallas isogeny is a group homomorphism on rational points.** All +of its hypotheses are discharged by the 2-torsion exclusions. -/ +theorem iso_map_add (P Q : SWPoint isoCurve) : + iso.map (P + Q) = iso.map P + iso.map Q := + iso.map_add (by decide) iso_no_onCurve_y_zero no_onCurve_y_zero P Q + end Pallas namespace Vesta @@ -80,6 +133,45 @@ theorem card_eq : Nat.card (SWPoint curve) = PALLAS_BASE_CARD := by decide · exact fun _ => eq_zero_of_two_nsmul_eq_zero (by decide) no_onCurve_y_zero +/-- A prime-order witness on iso-Vesta, at the smallest square abscissa `x = 4`. -/ +def isoGpt : SWPoint isoCurve := + ⟨4, 2165270085553270387583265107994083524758817942147891525126107618954199130179, + Or.inl (by decide)⟩ + +theorem isoGpt_ne_zero : isoGpt ≠ 0 := by decide + +/-- `[p] G = 𝒪` on iso-Vesta, where `p = PALLAS_BASE_CARD` is the iso-Vesta group order. -/ +theorem p_nsmul_isoGpt : PALLAS_BASE_CARD • isoGpt = 0 := by native_decide + +/-- No point of iso-Vesta has `y = 0`: it would map to a `y = 0` point of Vesta under the +isogeny, and Vesta has none. -/ +theorem iso_no_onCurve_y_zero (x : VestaBaseField) : + ¬ OnCurve isoCurve.A isoCurve.B (x, 0) := + iso.no_y_zero_of_codomain no_onCurve_y_zero x + +/-- **The iso-Vesta curve group has order `PALLAS_BASE_CARD`**, unconditionally — the same +order as Vesta, by the same route, with the 2-torsion exclusion transported through the +isogeny. -/ +theorem iso_card_eq : Nat.card (SWPoint isoCurve) = PALLAS_BASE_CARD := by + refine card_eq_of_prime_witness_of_card_lt_three_mul isoCurve PALLAS_BASE_is_prime + isoGpt_ne_zero p_nsmul_isoGpt ?_ ?_ + · rw [show Fintype.card VestaBaseField = PALLAS_SCALAR_CARD from ZMod.card _] + decide + · exact fun _ => eq_zero_of_two_nsmul_eq_zero (by decide) iso_no_onCurve_y_zero + +/-- The isogeny iso-Vesta → Vesta is a bijection on rational points, by counting: it is +injective with no homomorphism property consumed (`ThreeIsogeny.map_injective`), and the +two groups have the same order. -/ +theorem iso_map_bijective : Function.Bijective iso.map := + iso.map_bijective (by decide) no_onCurve_y_zero (iso_card_eq.trans card_eq.symm) + + +/-- **The deployed Vesta isogeny is a group homomorphism on rational points.** All +of its hypotheses are discharged by the 2-torsion exclusions. -/ +theorem iso_map_add (P Q : SWPoint isoCurve) : + iso.map (P + Q) = iso.map P + iso.map Q := + iso.map_add (by decide) iso_no_onCurve_y_zero no_onCurve_y_zero P Q + end Vesta end CompElliptic.Curves.Pasta diff --git a/CompElliptic/Fields/Residue.lean b/CompElliptic/Fields/Residue.lean index 870d91e..e1aaad1 100644 --- a/CompElliptic/Fields/Residue.lean +++ b/CompElliptic/Fields/Residue.lean @@ -5,6 +5,8 @@ as described in the files LICENSE-APACHE and LICENSE-MIT. Authors: Gregor Mitscha-Baude -/ import Mathlib.FieldTheory.Finite.Basic +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.LinearCombination /-! # Higher-power residues in a finite field @@ -19,6 +21,11 @@ nothing about the structure of `Fˣ`, whereas the converse would need its cyclic This is used to derive the concrete non-residue facts about the Pasta base fields in `Curves.Pasta` (`5` is not a square, and `-5` is not a cube in either field). + +`cubic_no_root_of_resolvent_noncube` turns the cube case of that certificate into a no-root +certificate for a depressed cubic, via Cardano's method. `Hashing/PastaSSWU.lean` uses it to +discharge RFC 9380's criterion 3 (irreducibility of `g(X) - Z`) for the deployed hash-to-curve +parameters. -/ namespace CompElliptic.Fields @@ -39,4 +46,66 @@ theorem not_exists_pow_eq_of_pow_ne_one {F : Type*} [Field F] [Fintype F] {n : rw [← pow_mul, Nat.mul_div_cancel' hn] exact FiniteField.pow_card_sub_one_eq_one x hx +/-- **Cardano's method as a no-root certificate for a depressed cubic.** Suppose `s` is a +square root of the discriminant of the resolvent quadratic (`27·s² = 27·q² + 4·A³`) and `w` +is the corresponding resolvent root (`2·w = -q + s`). If `w` is not a cube, then +`x³ + A·x + q` has no roots. + +This is Cardano's formula run backwards. A root would split as `x = u + v` with +`3·u·v = -A`, making `u³` and `v³` the two roots of the resolvent quadratic `t² + q·t - A³/27`; +`w` is one of those roots, so it would be a cube. The proof stays inside `F`, with no +splitting field: for a root `x` with `3·x² + A ≠ 0`, setting `r := 3·s/(3·x² + A)` gives +`((x+r)³ - 8·w)·((x-r)³ - 8·w) = 0` as a polynomial consequence of the hypotheses, so `w` is +the cube of `(x+r)/2` or of `(x-r)/2`. A root with `3·x² + A = 0` forces `s = 0` and +`w = (-x)³` directly. + +Over a finite field a cubic with no roots is irreducible. So this lemma, with +`not_exists_pow_eq_of_pow_ne_one` certifying the non-cube, makes RFC 9380's criterion 3 +checkable by `decide` from two precomputed field elements. -/ +theorem cubic_no_root_of_resolvent_noncube {F : Type*} [Field F] + (h2 : (2 : F) ≠ 0) (h3 : (3 : F) ≠ 0) {A q s w : F} + (hs : 27 * s ^ 2 = 27 * q ^ 2 + 4 * A ^ 3) + (hw : 2 * w = -q + s) + (hnc : ¬ ∃ u : F, u ^ 3 = w) : + ∀ x : F, x ^ 3 + A * x + q ≠ 0 := by + intro x hx + have h27 : (27 : F) ≠ 0 := by + have h := pow_ne_zero 3 h3 + norm_num at h + exact h + by_cases hd : 3 * x ^ 2 + A = 0 + · -- A root that is also a critical point: then `s = 0` and `w = (-x)³`, a cube. + have hq : q = 2 * x ^ 3 := by linear_combination hx - x * hd + have hs0 : s = 0 := by + have h0 : 27 * s ^ 2 = 0 := by + linear_combination hs + 27 * (q + 2 * x ^ 3) * hq + + 4 * (A ^ 2 - 3 * A * x ^ 2 + 9 * x ^ 4) * hd + exact sq_eq_zero_iff.mp ((mul_eq_zero.mp h0).resolve_left h27) + refine hnc ⟨-x, mul_left_cancel₀ h2 ?_⟩ + linear_combination -hw + hq - hs0 + · -- Cardano's split inside `F`: `(x+r)/2` and `(x-r)/2` play the roles of `u` and `v`. + obtain ⟨r, hr⟩ : ∃ r : F, r = 3 * s / (3 * x ^ 2 + A) := ⟨_, rfl⟩ + have hkey : 27 * s ^ 2 = (3 * x ^ 2 + A) ^ 2 * (3 * x ^ 2 + 4 * A) := by + linear_combination hs + 27 * (q - x ^ 3 - A * x) * hx + have hr3 : 3 * r ^ 2 = 3 * x ^ 2 + 4 * A := by + rw [hr] + field_simp + linear_combination hkey + have hpr : 3 * ((x + r) * (x - r)) = -(4 * A) := by linear_combination -hr3 + have hsum : (x + r) ^ 3 + (x - r) ^ 3 = -(8 * q) := by + linear_combination 2 * x * hr3 + 8 * hx + have hwq : 108 * (w ^ 2 + q * w) = 4 * A ^ 3 := by + linear_combination hs + 27 * (2 * w + q + s) * hw + have h0 : 27 * (((x + r) ^ 3 - 8 * w) * ((x - r) ^ 3 - 8 * w)) = 0 := by + linear_combination + (9 * ((x + r) * (x - r)) ^ 2 - 12 * ((x + r) * (x - r)) * A + 16 * A ^ 2) * hpr + - 216 * w * hsum + 16 * hwq + rcases mul_eq_zero.mp ((mul_eq_zero.mp h0).resolve_left h27) with h | h + · refine hnc ⟨(x + r) / 2, ?_⟩ + field_simp + linear_combination h + · refine hnc ⟨(x - r) / 2, ?_⟩ + field_simp + linear_combination h + end CompElliptic.Fields diff --git a/CompElliptic/Fields/Sqrt.lean b/CompElliptic/Fields/Sqrt.lean index 0351698..b849cdf 100644 --- a/CompElliptic/Fields/Sqrt.lean +++ b/CompElliptic/Fields/Sqrt.lean @@ -310,6 +310,48 @@ theorem sqrt?_isSome_of_isSquare {F : Type*} [Field F] [Fintype F] [DecidableEq · -- a ≠ 0 and the residue test failed: contradicted by Euler's criterion for a square. exact absurd (by rw [fpow_spec, ← hexp]; exact (FiniteField.isSquare_iff hchar h0).mp ha) h1 +/-- A valid `rootOfUnity` is a quadratic non-residue. It has full 2-power order, so its +Euler power `rootOfUnity ^ ((card-1)/2) = (rootOfUnity ^ (2^(twoAdicity-1)))^oddPart` +evaluates to `(-1)^oddPart = -1`, whereas Euler's criterion gives `1` for a nonzero +square. This lets a deployment reuse `rootOfUnity` as an auxiliary nonsquare with no +per-field computation. -/ +theorem rootOfUnity_not_isSquare {F : Type*} [Field F] [Fintype F] + (d : TonelliShanks F) : ¬ IsSquare d.rootOfUnity := by + intro hsq + have hodd : Fintype.card F % 2 = 1 := by + have h2 : 2 ∣ 2^d.twoAdicity * d.oddPart := + (dvd_pow_self 2 d.valid.twoAdicity_pos.ne').mul_right d.oddPart + rw [d.valid.card_eq]; omega + have hchar : ringChar F ≠ 2 := fun h => by + have := FiniteField.even_card_of_char_two h; omega + have hpow : 2^d.twoAdicity = 2 * 2^(d.twoAdicity - 1) := by + rw [← pow_succ', Nat.sub_add_cancel d.valid.twoAdicity_pos] + have hexp : Fintype.card F / 2 = 2^(d.twoAdicity - 1) * d.oddPart := by + rw [d.valid.card_eq, hpow, mul_assoc]; omega + -- `rootOfUnity ≠ 0`, since it has a power equal to `1`. + have hone : d.rootOfUnity ^ 2^d.twoAdicity = 1 := by + rw [← d.valid.rootOfUnity_order]; exact pow_orderOf_eq_one _ + have hne : d.rootOfUnity ≠ 0 := fun h0 => by + rw [h0, zero_pow (by positivity : (2:ℕ)^d.twoAdicity ≠ 0)] at hone + exact zero_ne_one hone + -- The half power squares to `1` but is not `1` (the order is too big), so it is `-1`. + have hhalf : d.rootOfUnity ^ 2^(d.twoAdicity - 1) = -1 := by + have hsq1 : d.rootOfUnity ^ 2^(d.twoAdicity - 1) + * d.rootOfUnity ^ 2^(d.twoAdicity - 1) = 1 := by + rw [← pow_add, ← two_mul, ← hpow]; exact hone + refine (mul_self_eq_one_iff.mp hsq1).resolve_left fun h1 => ?_ + have hdvd : orderOf d.rootOfUnity ∣ 2^(d.twoAdicity - 1) := + orderOf_dvd_iff_pow_eq_one.mpr h1 + rw [d.valid.rootOfUnity_order] at hdvd + have hle := (Nat.pow_dvd_pow_iff_le_right (by norm_num : (1:ℕ) < 2)).mp hdvd + have := d.valid.twoAdicity_pos + omega + -- Euler's power of the square is `1`, but it evaluates to `(-1)^oddPart = -1`. + have heuler : d.rootOfUnity ^ (Fintype.card F / 2) = 1 := + (FiniteField.isSquare_iff hchar hne).mp hsq + rw [hexp, pow_mul, hhalf, d.valid.oddPart_odd.neg_one_pow] at heuler + exact Ring.neg_one_ne_one_of_char_ne_two hchar heuler + end TonelliShanks end CompElliptic.Fields diff --git a/CompElliptic/Hashing/CharacterSum.lean b/CompElliptic/Hashing/CharacterSum.lean new file mode 100644 index 0000000..ee4747e --- /dev/null +++ b/CompElliptic/Hashing/CharacterSum.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import Mathlib.NumberTheory.LegendreSymbol.AddCharacter + +/-! +# Character sums of odd mappings + +A *mapping* here is any function `f : F → G` from a finite domain into a finite +abelian group — the term is RFC 9380's, whose `map_to_curve` functions are the +motivating instances. (The mathematical literature calls the same objects +*encodings*, as in "admissible encoding" and "well-distributed encoding"; +CompElliptic reserves *encoding* for the scheme used to translate group elements +into their bit- or byte-sequence depictions and back. See +`design/naming-survey.md`.) + +We study the character sum `∑ u, ψ (f u)` for an additive character `ψ` of `G`. +These sums control how close `f`, and sums of independent copies of it, come to +the uniform distribution on `G`. + +The mappings used to hash to elliptic curves (simplified SWU and its relatives) +choose the sign of the `y`-coordinate from the sign of the input. That sign rule +makes the mapping **odd**: `f (-u) = -f u`. This file proves that oddness alone +forces two facts: + +* the value multiplicity is symmetric under negation (`IsOdd.mult_neg`); and +* `f` sends `0` to `0` when `G` has odd order (`IsOdd.map_zero`). + +The main identity (`charSum_eq`) rewrites `∑ u, ψ (f u)` as the character transform +of `fun Q => mult f Q - 1`, the deviation of the value multiplicity from a perfect +covering. The sign convention has disappeared. What remains is a statement about +which group elements `f` covers, and with what multiplicity; `IsOdd.mult_neg` says +that residual is negation-symmetric. Bounding it is out of scope here — it rests on +the Weil bound (the Riemann hypothesis for curves; Weil 1948) applied to the +mapping's covering curve, stated as an explicit hypothesis with full references in +`CompElliptic.Hashing.WellDistributed`. This file isolates the elementary reduction +that removes the sign convention from the problem. +-/ + +namespace CompElliptic.Hashing + +open Finset + +variable {F : Type*} [AddGroup F] [Fintype F] [DecidableEq F] +variable {G : Type*} [AddCommGroup G] [Fintype G] [DecidableEq G] +variable {f : F → G} + +/-- `mult f Q` is the number of inputs that `f` maps to `Q`. -/ +def mult (f : F → G) (Q : G) : ℕ := (univ.filter fun u => f u = Q).card + +/-- A mapping is *odd* when negating the input negates the output. The simplified +SWU sign convention —choose the square root `y` with `sgn0 y = sgn0 u`— makes the +mapping odd in this sense: `-u` has the opposite input sign, so it selects `-y`. -/ +def IsOdd (f : F → G) : Prop := ∀ u, f (-u) = -f u + +omit [Fintype F] [DecidableEq F] [DecidableEq G] in +/-- An odd mapping sends `0` to `0`, provided `G` has odd order. `f 0` equals its own +negation, so it is a `2`-torsion element; a group of odd order has none except `0`. -/ +theorem IsOdd.map_zero (hf : IsOdd f) (hG : Odd (Fintype.card G)) : f 0 = 0 := by + have h2 : (2 : ℕ) • f 0 = 0 := by + have h0 := hf 0 + rw [neg_zero] at h0 + rw [two_nsmul]; nth_rewrite 2 [h0]; exact add_neg_cancel (f 0) + have hdvd2 : addOrderOf (f 0) ∣ 2 := addOrderOf_dvd_iff_nsmul_eq_zero.mpr h2 + have hdvdc : addOrderOf (f 0) ∣ Fintype.card G := addOrderOf_dvd_card + have hg : Nat.gcd 2 (Fintype.card G) = 1 := hG.coprime_two_left + exact AddMonoid.addOrderOf_eq_one_iff.mp (Nat.dvd_one.mp (hg ▸ Nat.dvd_gcd hdvd2 hdvdc)) + +omit [Fintype G] in +/-- **Symmetrization.** The value multiplicity of an odd mapping is invariant under +negation: `f` covers `Q` and `-Q` equally often, with input negation the witnessing +bijection. This is the entire effect of the sign convention —over each fibre `{u, -u}` +it produces a value and its negation— and it is what makes the residual in +`charSum_eq` negation-symmetric. -/ +theorem IsOdd.mult_neg (hf : IsOdd f) (Q : G) : mult f (-Q) = mult f Q := by + unfold mult + have hset : (univ.filter fun u => f u = -Q) + = (univ.filter fun u => f u = Q).image (fun u => -u) := by + ext u + simp only [mem_filter, mem_univ, true_and, mem_image] + constructor + · intro hu; exact ⟨-u, by rw [hf u, hu, neg_neg], neg_neg u⟩ + · rintro ⟨v, hv, rfl⟩; rw [hf v, hv] + rw [hset, Finset.card_image_of_injective _ neg_injective] + +omit [AddGroup F] [DecidableEq F] in +/-- Regrouping the character sum by value: each `Q` is hit `mult f Q` times. Holds +for every mapping; no oddness is needed. -/ +theorem charSum_eq_mult (ψ : AddChar G ℂ) : + ∑ u, ψ (f u) = ∑ Q, (mult f Q : ℂ) * ψ Q := by + classical + have step1 : ∀ u, ψ (f u) = ∑ Q, if f u = Q then ψ Q else 0 := fun u => by + rw [Finset.sum_ite_eq univ (f u) fun Q => ψ Q]; simp + simp_rw [step1] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun Q _ => ?_ + rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul] + rfl + +omit [AddGroup F] [DecidableEq F] in +/-- **The character sum, with the sign convention removed.** For a nontrivial +character `ψ`, the sum `∑ u, ψ (f u)` equals the character transform of +`fun Q => mult f Q - 1` — the deviation of the value multiplicity from a perfect +covering. The identity itself needs no oddness (only that a nontrivial character +sums to zero over `G`); oddness enters through `IsOdd.mult_neg`, which makes that +deviation negation-symmetric and hence amenable to a Weil bound on the covering. -/ +theorem charSum_eq {ψ : AddChar G ℂ} (hψ : ψ ≠ 1) : + ∑ u, ψ (f u) = ∑ Q, ((mult f Q : ℂ) - 1) * ψ Q := by + rw [charSum_eq_mult] + have hzero : ∑ Q, ψ Q = 0 := AddChar.sum_eq_zero_of_ne_one hψ + have hsplit : ∑ Q, ((mult f Q : ℂ) - 1) * ψ Q + = (∑ Q, (mult f Q : ℂ) * ψ Q) - ∑ Q, ψ Q := by + rw [← Finset.sum_sub_distrib] + exact Finset.sum_congr rfl fun Q _ => by ring + rw [hsplit, hzero, sub_zero] + +end CompElliptic.Hashing diff --git a/CompElliptic/Hashing/PastaSSWU.lean b/CompElliptic/Hashing/PastaSSWU.lean new file mode 100644 index 0000000..0983e34 --- /dev/null +++ b/CompElliptic/Hashing/PastaSSWU.lean @@ -0,0 +1,477 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Curves.IsoPasta +import CompElliptic.Isogenies.Homomorphism +import CompElliptic.Curves.PastaOrder +import CompElliptic.Hashing.SimplifiedSWU +import CompElliptic.Hashing.SignedLift +import Mathlib.Tactic.ReduceModChar + +/-! +# The deployed simplified-SWU parameters for the Pasta curves + +The concrete `SSWUParams` instances for hashing to Pallas and Vesta, as deployed +(`hashtocurve.sage`, `pasta_curves`). Simplified SWU runs on the iso-curves +(which have `A ≠ 0`), with `Z = -13` for both curves, the parity sign function +`sgn0`, the square-root split over the nonsquare `lam := rootOfUnity`, and +`θ = √(Z/lam)` precomputed. `lam` is the primitive `2^{32}`-nd root of unity +`5ᵀ` that drives Tonelli–Shanks, which `pasta_curves` reuses as `ROOT_OF_UNITY`. +`lam` needs no per-field non-residue check: a full-order root of unity is a +nonsquare (`TonelliShanks.rootOfUnity_not_isSquare`). + +The `θ` values are the `THETA` constants of `pasta_curves` +( +for Pallas, `…#L1199` for Vesta); the `example`s below tie the hex literals to +the reference's `from_raw` limbs. Either square root of `Z/lam` would work: `θ` +enters only the nonsquare branch's candidate ordinate, whose sign the final +parity-matching step overrides. We use the same root as `pasta_curves` and +`zcash-test-vectors` so that intermediate values can be compared directly. +`hashtocurve.sage` +() +computes the same parameters at lines 211–217 (`h = F.g` is `5ᵀ`, from +`SqrtField`'s `g = Mod(z, p)^m` with `z = 5`). + +The criterion-4 witnesses were computed with + +``` +F = GF(p) # resp. GF(q) +x = F(B) / (F(-13) * F(A)) +w = sqrt(x^3 + F(A)*x + F(B)) +``` + +for the iso-curve coefficients `A`, `B`. + +## Checking against references + +The fixtures below pin `mapXY` against `hashtocurve.sage`'s vectors, and +`mapHashOutputsToCurve` —the deployed construction after `hash_to_field`— against +the `zcash-test-vectors` group-hash vector for Pallas and the Halo 2 +fixed-generator derivation for Vesta. The missing Vesta vectors in +`zcash-test-vectors` are tracked by +, and direct +comparison against the `pasta_curves` Rust implementation by +. +-/ + +open CompElliptic.CurveForms.ShortWeierstrass CompElliptic.Fields.Pasta +open CompElliptic.Hashing + +namespace CompElliptic.Curves.Pasta + +namespace Pallas + +/-- `-13` is a quadratic non-residue in the Pallas base field: Euler's criterion, +with the power evaluated by fast modular exponentiation. -/ +theorem neg_thirteen_not_isSquare : ¬ IsSquare (-13 : PallasBaseField) := by + rw [ZMod.euler_criterion PALLAS_BASE_CARD (by decide : (-13 : PallasBaseField) ≠ 0)] + reduce_mod_char + decide + +/-- The precomputed resolvent root for RFC 9380's criterion 3 on iso-Pallas is not a +cube: `not_exists_pow_eq_of_pow_ne_one`, with the power evaluated by fast modular +exponentiation as for `neg_five_not_isCube`. -/ +theorem crit3_w_not_isCube : ¬ ∃ u : PallasBaseField, + u ^ 3 = (0x27234601c28978a85e0960ed291d6536dbecfb7c12f0173667d69bce9a3d69bc + : PallasBaseField) := by + have hcard : Fintype.card PallasBaseField = PALLAS_BASE_CARD := ZMod.card _ + refine Fields.not_exists_pow_eq_of_pow_ne_one (n := 3) (by rw [hcard]; decide) + (by decide) ?_ + rw [hcard] + show (0x27234601c28978a85e0960ed291d6536dbecfb7c12f0173667d69bce9a3d69bc + : ZMod PALLAS_BASE_CARD) ^ ((PALLAS_BASE_CARD - 1) / 3) ≠ 1 + reduce_mod_char + decide + +/-- The deployed simplified-SWU parameters targeting iso-Pallas. -/ +def sswu : SSWUParams PallasBaseField where + E := isoCurve + A_nonzero := by decide + Z := -13 + Z_nonsquare := neg_thirteen_not_isSquare + d := pallasBase + lam := pallasBase.rootOfUnity + lam_nonsquare := pallasBase.rootOfUnity_not_isSquare + θ := 0x0f7bdb65814179b44647aef782d5cdc851f64fc4dc888857ca330bcc09ac318e + θ_spec := by decide + sgn := sgn0 + crit2 := by decide + crit3 := by + -- `s` is a square root of the resolvent discriminant and `w` the resolvent + -- root, precomputed in Sagemath for `q := B - Z`; `decide` checks both. + have h := Fields.cubic_no_root_of_resolvent_noncube + (h2 := (by decide : (2 : PallasBaseField) ≠ 0)) + (h3 := (by decide : (3 : PallasBaseField) ≠ 0)) + (A := isoCurve.A) (q := isoCurve.B + 13) + (s := 0x0e468c038512f150bc12c1da523aca6d95935dfc1c933551368006b0347ad875) + (w := 0x27234601c28978a85e0960ed291d6536dbecfb7c12f0173667d69bce9a3d69bc) + (hs := by decide) (hw := by decide) (hnc := crit3_w_not_isCube) + intro x hx + exact h x (by linear_combination hx) + crit4 := ⟨0x0333fa3f8cb3bbd6e18f2fba2717db760fa5b179f0e2993f73395bb94a9eabe4, by + -- Clear the divisions first: modular inversion under `decide`'s kernel + -- evaluation is infeasible, while the division-free identity is fast. + -- `field_simp` needs the *atomic* nonzero facts — it rewrites the + -- denominator to `13^3 * A^3`, which a combined `-13 * A ≠ 0` fails to + -- discharge, leaving a division behind. + have h13 : (13 : PallasBaseField) ≠ 0 := by decide + have hA : isoCurve.A ≠ 0 := by decide + field_simp [h13, hA] + decide⟩ + +/-- `θ` is byte-for-byte `pasta_curves`' `THETA` for `Fp` (`from_raw` +little-endian `u64` limbs, least significant first). -/ +example : sswu.θ = 0xca330bcc09ac318e + + 0x51f64fc4dc888857 * 2^64 + + 0x4647aef782d5cdc8 * 2^128 + + 0x0f7bdb65814179b4 * 2^192 := by decide + +/-- `sgn0` is a sign function on the Pallas base field: the modulus is odd. -/ +theorem isSignFunction_sgn0 : IsSignFunction (sgn0 (p := PALLAS_BASE_CARD)) := + haveI : NeZero PALLAS_BASE_CARD := ⟨by decide⟩ + CompElliptic.Hashing.isSignFunction_sgn0 (Nat.odd_iff.mpr (by decide)) + +/-- The deployed `map_to_curve` for Pallas: simplified SWU onto iso-Pallas, +then the 3-isogeny down to Pallas. -/ +def mapToCurve (u : PallasBaseField) : SWPoint curve := + iso.map (sswu.map u) + +/-- The deployed mapping is odd away from `0`: simplified SWU is +(`SSWUParams.map_neg`), and the isogeny commutes with negation +(`ThreeIsogeny.map_neg`). -/ +theorem mapToCurve_neg {u : PallasBaseField} (hu : u ≠ 0) : + mapToCurve (-u) = -(mapToCurve u) := by + simp only [mapToCurve] + rw [sswu.map_neg isSignFunction_sgn0 hu] + exact iso.map_neg (sswu.map u) + +/-- The zero-repaired deployed mapping is literally odd — the form the +character-sum analysis consumes. -/ +theorem isOdd_zeroRepaired_mapToCurve : IsOdd (zeroRepaired mapToCurve) := + isOdd_zeroRepaired fun _ hu => mapToCurve_neg hu + +/-- The zero-repair transport, composed at the deployed mapping: for every +character, the deployed and repaired character sums differ by exactly +`ψ (mapToCurve 0) - 1`. Conclusions about the literally-odd +`zeroRepaired mapToCurve` carry back to the deployed mapping at this `O(1)` +cost. -/ +theorem charSum_mapToCurve_sub_zeroRepaired (ψ : AddChar (SWPoint curve) ℂ) : + ∑ u, ψ (mapToCurve u) - ∑ u, ψ (zeroRepaired mapToCurve u) + = ψ (mapToCurve 0) - 1 := + charSum_sub_zeroRepaired mapToCurve ψ + +/-- In norm, the deployed-to-repaired character-sum shift is at most `2`. -/ +theorem norm_charSum_mapToCurve_sub_zeroRepaired (ψ : AddChar (SWPoint curve) ℂ) : + ‖∑ u, ψ (mapToCurve u) - ∑ u, ψ (zeroRepaired mapToCurve u)‖ ≤ 2 := + norm_charSum_sub_zeroRepaired mapToCurve ψ + +/-- The deployed hash-to-curve construction for Pallas after `hash_to_field`: +add on the iso-curve, apply the isogeny once. -/ +def mapHashOutputsToCurve (u₀ u₁ : PallasBaseField) : SWPoint curve := + iso.mapHashOutputsToCurve sswu.map u₀ u₁ + +/-- The construction agrees with mapping each point down and adding on +Pallas — the order `zcash-test-vectors` and `pasta_curves` use — by the +homomorphism. -/ +theorem mapHashOutputsToCurve_eq (u₀ u₁ : PallasBaseField) : + mapHashOutputsToCurve u₀ u₁ = mapToCurve u₀ + mapToCurve u₁ := + iso_map_add (sswu.map u₀) (sswu.map u₁) + +/-! ### Fixtures for `mapXY` against `hashtocurve.sage` + +The first three `u` values are the script's self-test inputs (`u = 0` exercises +the exceptional `ta = 0` branch). The last two are the field elements its +`hash_to_field` produces for the `hash_to_pallas_jacobian` test vector +(`msg = "Trans rights now!"`, `DST = "z.cash:test-pallas_XMD:BLAKE2b_SSWU_RO_"`), +extracted by running the script with `VERBOSE = True`; they take opposite +`IsSquare` branches. Expected outputs are +`map_to_curve_simple_swu(...).to_affine(IsoEp)` from the same script. -/ + +example : sswu.mapXY 0 = + (0x2c150731d26bf03de9585bf1a0c67160f6ca6e5ce0e2b674af333253bca63800, + 0x0333fa3f8cb3bbd6e18f2fba2717db760fa5b179f0e2993f73395bb94a9eabe4) := by + native_decide + +example : sswu.mapXY 1 = + (0x0bb222fb72c9783337e0e9e1c4282c391407f5f9d9fcc94ace1d677dbf3ba120, + 0x36366437b8048026b50626f004b30dd99389b090d8a502d78f3fbd565fe86477) := by + native_decide + +example : sswu.mapXY + 0x123456789abcdef123456789abcdef123456789abcdef123456789abcdef0123 = + (0x24f27f64d536dbc39c03c18fda8e65a9a12b7418818ed76c040b83ef97b25723, + 0x03e6c9c2288650534d76b391d26c8ee6e4e99fad1f41b411481fa968f8184a75) := by + native_decide + +example : sswu.mapXY + 0x1bdd4c3fc1169a6d8eb82d66652f44a1e4a73cc1b6da4bba1d95fa6111c85a6f = + (0x05c3482fe40155e152fdc0be06c4766b67a2b3d8d9bb64ee6137382879dc2160, + 0x3825fb730c259375175ff31b94dc36dcf031b13f3116bda725f1c98717739f1f) := by + native_decide + +example : sswu.mapXY + 0x0dd7332b3108010636107798c0ea89f94c79fb0472cb7b8222c450142802e4af = + (0x2c6e5aa1a88cd76c8a9d436438d2993244bf7704e4f322a86d0890bd6cee28ab, + 0x0b20c46efea44d15e4828808c86a72789d54328635ba4274d8e9b48d9654f65b) := by + native_decide + +/-! ### The `zcash-test-vectors` group-hash fixture + +`zcash-test-vectors` pins `group_hash(b"z.cash:test", b"Trans rights now!")` — the +same `(msg, DST)` pair as the vector above, after `group_hash`'s DST expansion — +to an affine Pallas point: +. +The example pins `mapHashOutputsToCurve` at the vector's two `hash_to_field` +outputs (their `mapXY` coordinates are pinned above) to the reference point, +whose coordinates are quoted in decimal, verbatim from `group_hash.py`. -/ + +example : + mapHashOutputsToCurve + 0x1bdd4c3fc1169a6d8eb82d66652f44a1e4a73cc1b6da4bba1d95fa6111c85a6f + 0x0dd7332b3108010636107798c0ea89f94c79fb0472cb7b8222c450142802e4af + = ⟨10899331951394555178876036573383466686793225972744812919361819919497009261523, + 851679174277466283220362715537906858808436854303373129825287392516025427980, + Or.inl (by native_decide)⟩ := by + native_decide + +end Pallas + +namespace Vesta + +/-- `-13` is a quadratic non-residue in the Vesta base field: Euler's criterion, +with the power evaluated by fast modular exponentiation. -/ +theorem neg_thirteen_not_isSquare : ¬ IsSquare (-13 : VestaBaseField) := by + rw [ZMod.euler_criterion PALLAS_SCALAR_CARD (by decide : (-13 : VestaBaseField) ≠ 0)] + reduce_mod_char + decide + +/-- The precomputed resolvent root for RFC 9380's criterion 3 on iso-Vesta is not a +cube: `not_exists_pow_eq_of_pow_ne_one`, with the power evaluated by fast modular +exponentiation as for `neg_five_not_isCube`. -/ +theorem crit3_w_not_isCube : ¬ ∃ u : VestaBaseField, + u ^ 3 = (0x2236a351e7028c01c80f079ca37fd81fd024e547a51813136e8516e4eaf7d998 + : VestaBaseField) := by + have hcard : Fintype.card VestaBaseField = PALLAS_SCALAR_CARD := ZMod.card _ + refine Fields.not_exists_pow_eq_of_pow_ne_one (n := 3) (by rw [hcard]; decide) + (by decide) ?_ + rw [hcard] + show (0x2236a351e7028c01c80f079ca37fd81fd024e547a51813136e8516e4eaf7d998 + : ZMod PALLAS_SCALAR_CARD) ^ ((PALLAS_SCALAR_CARD - 1) / 3) ≠ 1 + reduce_mod_char + decide + +/-- The deployed simplified-SWU parameters targeting iso-Vesta. -/ +def sswu : SSWUParams VestaBaseField where + E := isoCurve + A_nonzero := by decide + Z := -13 + Z_nonsquare := neg_thirteen_not_isSquare + d := vestaBase + lam := vestaBase.rootOfUnity + lam_nonsquare := vestaBase.rootOfUnity_not_isSquare + θ := 0x2b3483a1ee9a382f53c3808d9e2f235738578ccadf03ac27632cae9872df1b5d + θ_spec := by decide + sgn := sgn0 + crit2 := by decide + crit3 := by + -- As for Pallas: precomputed Sagemath certificates, checked by `decide`. + have h := Fields.cubic_no_root_of_resolvent_noncube + (h2 := (by decide : (2 : VestaBaseField) ≠ 0)) + (h3 := (by decide : (3 : VestaBaseField) ≠ 0)) + (A := isoCurve.A) (q := isoCurve.B + 13) + (s := 0x046d46a3ce051803901e0f3946ffb03f7e033193409b7d4950c342a8d5efb82d) + (w := 0x2236a351e7028c01c80f079ca37fd81fd024e547a51813136e8516e4eaf7d998) + (hs := by decide) (hw := by decide) (hnc := crit3_w_not_isCube) + intro x hx + exact h x (by linear_combination hx) + crit4 := ⟨0x1e004d52293581bcab805716bdb5ebcd8c1742ca68528997460503c7a51dd3e5, by + -- Clear the divisions first, as for Pallas. + have h13 : (13 : VestaBaseField) ≠ 0 := by decide + have hA : isoCurve.A ≠ 0 := by decide + field_simp [h13, hA] + decide⟩ + +/-- `θ` is byte-for-byte `pasta_curves`' `THETA` for `Fq` (`from_raw` +little-endian `u64` limbs, least significant first). -/ +example : sswu.θ = 0x632cae9872df1b5d + + 0x38578ccadf03ac27 * 2^64 + + 0x53c3808d9e2f2357 * 2^128 + + 0x2b3483a1ee9a382f * 2^192 := by decide + +/-- `sgn0` is a sign function on the Vesta base field: the modulus is odd. -/ +theorem isSignFunction_sgn0 : IsSignFunction (sgn0 (p := PALLAS_SCALAR_CARD)) := + haveI : NeZero PALLAS_SCALAR_CARD := ⟨by decide⟩ + CompElliptic.Hashing.isSignFunction_sgn0 (Nat.odd_iff.mpr (by decide)) + +/-- The deployed `map_to_curve` for Vesta: simplified SWU onto iso-Vesta, +then the 3-isogeny down to Vesta. -/ +def mapToCurve (u : VestaBaseField) : SWPoint curve := + iso.map (sswu.map u) + +/-- The deployed mapping is odd away from `0`: simplified SWU is +(`SSWUParams.map_neg`), and the isogeny commutes with negation +(`ThreeIsogeny.map_neg`). -/ +theorem mapToCurve_neg {u : VestaBaseField} (hu : u ≠ 0) : + mapToCurve (-u) = -(mapToCurve u) := by + simp only [mapToCurve] + rw [sswu.map_neg isSignFunction_sgn0 hu] + exact iso.map_neg (sswu.map u) + +/-- The zero-repaired deployed mapping is literally odd — the form the +character-sum analysis consumes. -/ +theorem isOdd_zeroRepaired_mapToCurve : IsOdd (zeroRepaired mapToCurve) := + isOdd_zeroRepaired fun _ hu => mapToCurve_neg hu + +/-- The zero-repair transport, composed at the deployed mapping: for every +character, the deployed and repaired character sums differ by exactly +`ψ (mapToCurve 0) - 1`. Conclusions about the literally-odd +`zeroRepaired mapToCurve` carry back to the deployed mapping at this `O(1)` +cost. -/ +theorem charSum_mapToCurve_sub_zeroRepaired (ψ : AddChar (SWPoint curve) ℂ) : + ∑ u, ψ (mapToCurve u) - ∑ u, ψ (zeroRepaired mapToCurve u) + = ψ (mapToCurve 0) - 1 := + charSum_sub_zeroRepaired mapToCurve ψ + +/-- In norm, the deployed-to-repaired character-sum shift is at most `2`. -/ +theorem norm_charSum_mapToCurve_sub_zeroRepaired (ψ : AddChar (SWPoint curve) ℂ) : + ‖∑ u, ψ (mapToCurve u) - ∑ u, ψ (zeroRepaired mapToCurve u)‖ ≤ 2 := + norm_charSum_sub_zeroRepaired mapToCurve ψ + +/-- The deployed hash-to-curve construction for Vesta after `hash_to_field`: +add on the iso-curve, apply the isogeny once. -/ +def mapHashOutputsToCurve (u₀ u₁ : VestaBaseField) : SWPoint curve := + iso.mapHashOutputsToCurve sswu.map u₀ u₁ + +/-- The construction agrees with mapping each point down and adding on +Vesta — the order `zcash-test-vectors` and `pasta_curves` use — by the +homomorphism. -/ +theorem mapHashOutputsToCurve_eq (u₀ u₁ : VestaBaseField) : + mapHashOutputsToCurve u₀ u₁ = mapToCurve u₀ + mapToCurve u₁ := + iso_map_add (sswu.map u₀) (sswu.map u₁) + +/-! ### Fixtures for `mapXY` against `hashtocurve.sage` + +As for Pallas: the script's three self-test inputs, then the two field +elements of its `hash_to_vesta_jacobian` test vector (`msg = "hello"`, +`DST = "z.cash:test-vesta_XMD:BLAKE2b_SSWU_RO_"`), which take opposite +`IsSquare` branches (in the opposite order to the Pallas vector). -/ + +example : sswu.mapXY 0 = + (0x252ca74e8e7b7846cb59112c429e22166fa1dc53f442887ab66e73e89c4736c2, + 0x21ffb2add6ca7e43547fa8e9424a1432962f5631a1421f464641e7595ae22c1c) := by + native_decide + +example : sswu.mapXY 1 = + (0x17ea828ed62281a1bb3dd72d681ada4ff18f20da82e1e7a022413d7d565a5eff, + 0x163cdc7b7bf3906fd03a189d0ba3a4d8af5ac6cb7a49db6257016680903bcff7) := by + native_decide + +example : sswu.mapXY + 0x123456789abcdef123456789abcdef123456789abcdef123456789abcdef0123 = + (0x3b45aa24da5eead97e0e822c3a6cd21de7753d6bcb80e86b2a83d7965ae0fdcd, + 0x2c1f0a3607e56114240c198424efc075a8754031486a04daa7d167cbcb2e0f4f) := by + native_decide + +example : sswu.mapXY + 0x02ff3bc53fd8e95662b4614d32237aef43b36e53774401004eac13537507b1ac = + (0x046a6cd3eb4941e556826c63ea8bd0d7c99d73c4a9bcbce66c8a69f39acb57d9, + 0x03bf12b7e097fc69f44204aaa1f2024573051cc0afdf6c9cc7e613d758eb17d6) := by + native_decide + +example : sswu.mapXY + 0x249ed75088f240d4c420e893e3b9cebfeb151a2a6e3e3f7dad559a98f139fcef = + (0x3c59d550a420b986f9c65efd30753c1e31e732d8d572bd9805d82ee585e9ce80, + 0x328cde92a9c7c5ff3138cee2e342898ec171f46f6e1f6c40d364196a0eefafbf) := by + native_decide + +/-! ### The composed group-hash fixture + +As for Pallas, but against `hashtocurve.sage`'s own `hash_to_vesta_jacobian` +vector. The script prints Jacobian coordinates; the first example below checks +the conversion to affine (`x/z²`, `y/z³`), with the printed `Eq { x, y, z }` +output quoted verbatim, so the pinned point can be compared directly against +the script's output. `zcash-test-vectors` carries no Vesta group-hash vector +yet, because Orchard's group hash targets Pallas — the gap is + — and this +`(msg, DST)` pair (`D = b"z.cash:test"`, `msg = b"hello"`, expanded over +`vesta`) is the shape such a vector is expected to take. -/ + +-- The script's printed Jacobian output, converted to the affine point pinned below. +example : + ((0x12763505036e0e1a6684b7a7d8d5afb7378cc2b191a95e34f44824a06fcbd08e + / 0x1b58d4aa4d68c3f4d9916b77c79ff9911597a27f2ee46244e98eb9615172d2ad ^ 2 : + VestaBaseField), + (0x0256eafc0188b79bfa7c4b2b393893ddc298e90da500fa4a9aee17c2ea4240e6 + / 0x1b58d4aa4d68c3f4d9916b77c79ff9911597a27f2ee46244e98eb9615172d2ad ^ 3 : + VestaBaseField)) + = (0x2e983e009cf3b86bc95f91b3411bd6cbd0a87f8c3c3dae80f3f2637084849204, + 0x310fb8f3316d069a1fb9374bdbc0fb1391c864a5208b2a812341db7f50b2e106) := by + native_decide + +example : + mapHashOutputsToCurve + 0x02ff3bc53fd8e95662b4614d32237aef43b36e53774401004eac13537507b1ac + 0x249ed75088f240d4c420e893e3b9cebfeb151a2a6e3e3f7dad559a98f139fcef + = ⟨0x2e983e009cf3b86bc95f91b3411bd6cbd0a87f8c3c3dae80f3f2637084849204, + 0x310fb8f3316d069a1fb9374bdbc0fb1391c864a5208b2a812341db7f50b2e106, + Or.inl (by native_decide)⟩ := by + native_decide + +/-! ### The Halo 2 fixed-generator spot-checks + +Halo 2's `Params::new` derives the `2^k` polynomial-commitment generators +(`k = 11` for the Orchard Action circuit) plus `W` and `U` by hash-to-curve +over Vesta with domain prefix `"Halo2-Parameters"`: generator `i` hashes the +five bytes `[0] ++ u32_le(i)`, `W` hashes `[1]`, and `U` hashes `[2]` +(). +These spot-check the generators at indices `0` and `2^{11} - 1`, and `W` and +`U`; the `hash_to_field` outputs and expected points were computed with +`hashtocurve.sage` at `DST = "Halo2-Parameters-vesta_XMD:BLAKE2b_SSWU_RO_"` +and are recorded in the issue above. -/ + +-- The generator at index `0`. +example : + mapHashOutputsToCurve + 0x0689c26b8485b6125b554ae564602872c4169750375c764f5f74741d8a6e7241 + 0x089aae9d92dd9f5758bd8a7e3cb911a97e8aef5cc81e3c0767c18a5267954aa6 + = ⟨0x3decc7d8be779b2b8505a808c7e8109341ef95101391f5589738bf79d05e0645, + 0x30ac4ee40eb29dca411d3869f0bf452cb569bc56a0d674b998e794ce233f4531, + Or.inl (by native_decide)⟩ := by + native_decide + +-- The generator at index `2^{11} - 1 = 2047`. +example : + mapHashOutputsToCurve + 0x0a360980c8054088f9be339559eace1e7e985c3ac942bed952e7aef3103d178e + 0x0b0130d836325841f078cd1e94ba58d25311c47c6e31a6a1239424d36729d592 + = ⟨0x11743a31bb9d8d5259d8101be81cfd6662f8da73d9ccf609cf678a66841a49bd, + 0x3789a55b81d0b4779cb2869130f30043f124695da7b64b08934cc2401f51214c, + Or.inl (by native_decide)⟩ := by + native_decide + +-- `W`. +example : + mapHashOutputsToCurve + 0x3942ef4eff2efc40dbabf511bb9d2f4d2d564ae89a155959ee1deef5dbc1a25c + 0x239a4c1aeb9e98b3a5d0909d945babcbed9c34bcfe13501fa71e1968c5a8219d + = ⟨0x2bbc94ef7b22aebef24f9a4b0cc1831882548b605171366017d45c3e6fd92075, + 0x082b801a6e176239943bfb759fb02138f47a5c8cc4aa7fa0af559fde4e3abd97, + Or.inl (by native_decide)⟩ := by + native_decide + +-- `U`. +example : + mapHashOutputsToCurve + 0x08786c60d346bd37392ad60bc4140e7c560ffad514418a9fc907cbfb481f6deb + 0x2da9e3ae3a7ebb742dcb78280b4c38a36819ede1c7ec3093615eb5b8729c2d8f + = ⟨0x17a8b1830ad3ba49f240c0d0244f6911f6ac5997bba0d5c7cc61bffddcc49d37, + 0x2df4dd8b1be11f9db0176cf4cd0e52ff5528f693211cb7212bf6acd3327782cf, + Or.inl (by native_decide)⟩ := by + native_decide + +end Vesta + +end CompElliptic.Curves.Pasta diff --git a/CompElliptic/Hashing/SignedLift.lean b/CompElliptic/Hashing/SignedLift.lean new file mode 100644 index 0000000..9529bce --- /dev/null +++ b/CompElliptic/Hashing/SignedLift.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Hashing.CharacterSum +import CompElliptic.CurveForms.ShortWeierstrass +import Mathlib.Analysis.Normed.Ring.Finite +import Mathlib.Data.ZMod.Basic + +/-! +# The signed lift, and why hash-to-curve mappings are odd + +Hash-to-curve mappings compute an abscissa from the input and then choose between +the two points over it —`(x, y)` and `(x, -y)`— by a sign rule: take the `y` whose +"sign" matches the input's (RFC 9380's `sgn0`, the parity of the least +representative). This file isolates that mechanism as the *signed lift* of an +abscissa map through a *sign function*, and proves the structural consequence the +character-sum analysis rests on: the lift is odd, `f (-u) = -f u`, for every +nonzero input. Only two facts about the deployed construction enter: + +* the abscissa depends on the input only through its square, so it is *even* + (`u` and `-u` share an abscissa); and +* negation flips the sign of every nonzero field element, so it flips which of the + two points the sign rule selects. + +## The zero exception, made explicit + +The deployed mapping is *not* odd at `u = 0`: `-0 = 0`, so oddness there would +force `f 0 = -f 0` — a point of order dividing 2. For an odd-order curve group +the only such point is the identity, and the deployed mapping sends `0` to an +ordinary finite point via its exceptional branch. `zeroRepaired` is the variant +sending `0` to the identity; it is odd everywhere (`isOdd_zeroRepaired`). +`charSum_sub_zeroRepaired` makes the modelling cost exact: the repair shifts +every character sum by exactly `ψ (f 0) - 1` — in norm, at most `2` +(`norm_charSum_sub_zeroRepaired`). This is the `O(1)` bookkeeping term of the +pencil-and-paper analysis, carried here as an identity rather than an estimate. + +This file provides the generic layer, with the sign-function half instantiated +(`sgn0` on `ZMod p`, `isSignFunction_sgn0`). The concrete simplified-SWU +candidate map is `SSWUParams.candidateMap` (`Hashing/SimplifiedSWU.lean`), +whose signed lift is the mapping itself (`SSWUParams.map_eq_signedLift`). +`Hashing/PastaSSWU.lean` composes it with the isogenies as the deployed +`mapToCurve`. +-/ + +namespace CompElliptic.Hashing + +open Finset +open CompElliptic.CurveForms.ShortWeierstrass + +/-! ## Sign functions -/ + +section SignFunction + +variable {F : Type*} [AddGroup F] + +/-- A *sign function* labels each field element with a `Bool` so that negation +flips the label of every nonzero element. That is the only property of RFC 9380's +`sgn0` that the oddness of hash-to-curve mappings uses. (No constraint is placed +at `0`: negation fixes `0`, so no two-valued label can flip there.) -/ +def IsSignFunction (sgn : F → Bool) : Prop := ∀ v : F, v ≠ 0 → sgn (-v) ≠ sgn v + +end SignFunction + +/-- RFC 9380's `sgn0` for a prime field: the parity of the least nonnegative +representative. -/ +def sgn0 {p : ℕ} (v : ZMod p) : Bool := decide (v.val % 2 = 1) + +/-- For an odd modulus, parity is a sign function: a nonzero `v` has `-v` +represented by `p - val v`, and subtracting from the odd `p` flips parity. -/ +theorem isSignFunction_sgn0 {p : ℕ} [NeZero p] (hp : Odd p) : + IsSignFunction (sgn0 (p := p)) := by + intro v hv + haveI : NeZero v := ⟨hv⟩ + have hneg : (-v).val = p - v.val := ZMod.val_neg_of_ne_zero v + have hlt : v.val < p := ZMod.val_lt v + have hpos : 0 < v.val := + Nat.pos_of_ne_zero fun h0 => hv ((ZMod.val_eq_zero v).mp h0) + have hodd : p % 2 = 1 := Nat.odd_iff.mp hp + simp only [sgn0, hneg, ne_eq, decide_eq_decide] + omega + +/-! ## The signed lift -/ + +section SignedLift + +variable {F : Type*} [Field F] [DecidableEq F] {E : SWCurve F} + +omit [DecidableEq F] in +/-- Negation on `SWPoint` fixes the abscissa. -/ +@[simp] theorem SWPoint.neg_x (P : SWPoint E) : (-P).x = P.x := rfl + +omit [DecidableEq F] in +/-- Negation on `SWPoint` negates the ordinate. -/ +@[simp] theorem SWPoint.neg_y (P : SWPoint E) : (-P).y = -P.y := rfl + +/-- The *signed lift*: given a candidate point map `m`, correct the sign of +each output by matching the sign of its ordinate to the sign of the input. +This is the shape of RFC 9380's step "if `sgn0 u ≠ sgn0 y`, set `y = -y`". -/ +def signedLift (m : F → SWPoint E) (sgn : F → Bool) (u : F) : SWPoint E := + if sgn (m u).y = sgn u then m u else -(m u) + +omit [DecidableEq F] in +/-- **The signed lift is odd away from `0`.** The candidate map only has to be +even *up to sign* —`m (-u) = ±(m u)`— and the sign rule must flip on negation; +then negating a nonzero input negates the output point. The up-to-sign +allowance is what the deployed algorithm needs: its nonsquare branch computes +the candidate root as `θ·Z·u²·u·y1`, whose bare factor of `u` makes the +chooser odd rather than even there. That is harmless: at a fixed input, the +sign-matching step selects the same point whichever sign the chooser produced, +because the output's sign is re-derived from `sgn0 u`. Across `±u` the outputs +still have opposite signs —`sgn0` flips on negation— which is exactly the +oddness proved here. -/ +theorem signedLift_neg {m : F → SWPoint E} {sgn : F → Bool} + (hm : ∀ u, m (-u) = m u ∨ m (-u) = -(m u)) + (hsgn : IsSignFunction sgn) {u : F} (hu : u ≠ 0) : + signedLift m sgn (-u) = -(signedLift m sgn u) := by + have hflip : sgn (-u) ≠ sgn u := hsgn u hu + have hnn : ∀ P : SWPoint E, - -P = P := fun P => SWPoint.ext_pair (by simp) + have even_case : m (-u) = m u → + signedLift m sgn (-u) = -(signedLift m sgn u) := by + intro hre + by_cases h : sgn (m u).y = sgn u + · have h' : ¬ sgn (m (-u)).y = sgn (-u) := by + rw [hre] + exact fun hc => hflip (by rw [← hc, h]) + simp only [signedLift, if_pos h, if_neg h'] + rw [hre] + · have h' : sgn (m (-u)).y = sgn (-u) := by + rw [hre] + cases hb : sgn u <;> cases hc : sgn (m u).y <;> cases hd : sgn (-u) <;> + simp_all + simp only [signedLift, if_neg h, if_pos h'] + rw [hre, hnn] + rcases hm u with hr | hr + · exact even_case hr + · by_cases hy0 : (m u).y = 0 + · exact even_case (hr.trans (SWPoint.ext_pair + (by rw [SWPoint.neg_x, SWPoint.neg_y, hy0, neg_zero]))) + · have hyflip : sgn (m (-u)).y ≠ sgn (m u).y := by + rw [hr, SWPoint.neg_y] + exact hsgn (m u).y hy0 + by_cases h : sgn (m u).y = sgn u + · have h' : sgn (m (-u)).y = sgn (-u) := by + cases hb : sgn u <;> cases hc : sgn (m u).y <;> cases hd : sgn (-u) <;> + cases he : sgn (m (-u)).y <;> simp_all + simp only [signedLift, if_pos h, if_pos h'] + rw [hr] + · have h' : ¬ sgn (m (-u)).y = sgn (-u) := by + cases hb : sgn u <;> cases hc : sgn (m u).y <;> cases hd : sgn (-u) <;> + cases he : sgn (m (-u)).y <;> simp_all + simp only [signedLift, if_neg h, if_neg h'] + rw [hr] + +/-! ## Repairing the zero exception -/ + +variable {G : Type*} [AddCommGroup G] + +/-- The variant of a mapping that sends `0` to the identity and agrees with the +mapping everywhere else. The deployed hash-to-curve mapping differs from its +zero-repaired variant at the single input `0`; its exceptional branch produces a +finite point there. The repaired variant is what is literally odd. -/ +def zeroRepaired {F : Type*} [Zero F] [DecidableEq F] (f : F → G) : F → G := + fun u => if u = 0 then 0 else f u + +/-- A mapping that is odd away from `0` has an odd zero-repaired variant: at `0` +both sides are the identity, and elsewhere the repair does not fire. -/ +theorem isOdd_zeroRepaired {F : Type*} [AddGroup F] [DecidableEq F] {f : F → G} + (hodd : ∀ u : F, u ≠ 0 → f (-u) = -f u) : IsOdd (zeroRepaired f) := by + intro u + by_cases hu : u = 0 + · simp [zeroRepaired, hu] + · have hnu : -u ≠ 0 := neg_ne_zero.mpr hu + simp [zeroRepaired, hu, hnu, hodd u hu] + +/-- **The exact cost of the repair.** A mapping and its zero-repaired variant +agree except at `0`, so their character sums differ by exactly the difference of +the two character values there: `ψ (f 0) - 1`. This is the `O(1)` term of the +character-sum analysis, as an identity rather than an estimate. -/ +theorem charSum_sub_zeroRepaired {F : Type*} [Fintype F] [Zero F] [DecidableEq F] + (f : F → G) (ψ : AddChar G ℂ) : + ∑ u, ψ (f u) - ∑ u, ψ (zeroRepaired f u) = ψ (f 0) - 1 := by + rw [← Finset.add_sum_erase univ (fun u => ψ (f u)) (mem_univ 0), + ← Finset.add_sum_erase univ (fun u => ψ (zeroRepaired f u)) (mem_univ 0), + Finset.sum_congr rfl fun u hu => by + rw [show f u = zeroRepaired f u by simp [zeroRepaired, (Finset.mem_erase.mp hu).1]], + show zeroRepaired f 0 = 0 from if_pos rfl, AddChar.map_zero_eq_one] + ring + +/-- In norm, the repair's character-sum shift is at most `2` — the `O(1)` term +against sums of size `√#F`. -/ +theorem norm_charSum_sub_zeroRepaired {F : Type*} [Fintype F] [Zero F] + [DecidableEq F] [Fintype G] (f : F → G) (ψ : AddChar G ℂ) : + ‖∑ u, ψ (f u) - ∑ u, ψ (zeroRepaired f u)‖ ≤ 2 := by + rw [charSum_sub_zeroRepaired] + calc ‖ψ (f 0) - 1‖ ≤ ‖ψ (f 0)‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ + _ = 2 := by rw [ψ.norm_apply, norm_one]; norm_num + +end SignedLift + +end CompElliptic.Hashing diff --git a/CompElliptic/Hashing/SimplifiedSWU.lean b/CompElliptic/Hashing/SimplifiedSWU.lean new file mode 100644 index 0000000..95d8a87 --- /dev/null +++ b/CompElliptic/Hashing/SimplifiedSWU.lean @@ -0,0 +1,370 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Hashing.SignedLift +import CompElliptic.Fields.Sqrt +import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic + +/-! +# The simplified SWU mapping + +This file defines the deployed hash-to-curve mapping of the Zcash protocol +specification, mirrored from §5.4.9.8 ("Group Hash into Pallas and Vesta"). The +spec's presentation takes precedence over RFC 9380 by its own declaration; the +two agree on every step used here. The concrete Pasta instantiation and its +reference fixtures live in `Hashing/PastaSSWU.lean`, whose module documentation +records how the construction is checked against the reference implementations. + +## `sqrt_ratio` + +The subroutine `sqrt_ratio` (spec notation `sqrt_ratio_{GF(q)}(num, div)`): +divide, take a square root if one exists, and otherwise take a square root of +the ratio multiplied by a fixed nonsquare `lam` — which always exists, because a +nonsquare times a nonsquare is a square in a finite field +(`isSquare_mul_of_not_isSquare`, by multiplicativity of the quadratic +character). The `Bool` component reports which case occurred; the spec notes the +result is never `⊥`, which here is the fact that the `.getD 0` default is dead +code (`sqrtRatio_false_sq` proves the false branch still returns a genuine +root). The spec allows an arbitrary square root and an arbitrary nonsquare +`lam`; this implementation fixes the Tonelli–Shanks root of `Fields/Sqrt.lean` +and takes `lam` as a parameter, which matches the spec's note that neither +choice affects the mapping's output. + +## The mapping + +`mapXYUpToSign` computes the spec's steps with the spec's own intermediate +names (`Zuu`, `ta`, `x1num`, `xdiv`, `U`, `x2num`, `y1`, `y2`, `xnum`, `y'`), +stopping just before the sign-matching step; `mapXY` applies that final step, +so their composition is step-for-step the spec's list. `onCurve_mapXY` proves +the result lies on the curve —never the identity— and `map` packages both as +an `SWPoint`. The signed-lift section factors the mapping through `signedLift` +(`candidateMap`, `map_eq_signedLift`) and derives oddness away from `0` +(`map_neg`). The on-curve proof has three strands. The final +sign-matching step squares away. In the square branch, the curve equation at +`x1num/xdiv` is the definition of `U`. In the nonsquare branch the root `y1` +squares to `lam·U/xdiv³`, and the algebra rests on two facts. First, +`θ²·lam = Z` turns the extra factors of `y2 = θ·Zuu·u·y1` into exactly `Zuu³`. +Second, the identity `Zuu³·U = g(x2num/xdiv)·xdiv³` closes the generic case; it +is special to the SSWU choice of `x1num` and `xdiv`, and false in the +exceptional `ta = 0` case. The `ta = 0` case is unreachable in this branch: +RFC 9380's criterion 4 on `Z` makes `g(B/(Z·A))` a square there, so +`sqrt_ratio` took the square branch. + +## The `Z` criteria + +RFC 9380 §6.6.2 puts four criteria on `Z`. Two have mathematical content, and +the proofs here consume exactly those two: criterion 1 (`Z` nonsquare) makes +the two-candidate trick work, and criterion 4 (`g(B/(Z·A))` square) makes the +exceptional case land in the square branch. Criterion 2 (`Z ≠ -1`) and +criterion 3 (`g(X) - Z` irreducible over `F`) entered in draft 5 of the RFC +to avoid two patents on deterministic hashing to elliptic curves, +US 8,718,276 and US 8,712,038 (Icart et al., filed 2010, expiring June 2030; +see and +). + +The former patent claims constructions built on Skałba equalities. A Skałba +equality is an identity `g(X₁(t))·g(X₂(t))·g(X₃(t)) = U(t)²` between rational +functions: it forces some `g(Xᵢ(t))` to be square at every `t`, hence some +`Xᵢ(t)` to be an abscissa on the curve. Simplified SWU satisfies +`g(X₁(t))·g(X₂(t)) = Z·U(t)²`, so a third polynomial completing a Skałba +equality would need `g(X₃(t)) = Z` identically; criterion 3 makes `Z` miss +the image of `g` on `F`, so no such `X₃` exists and the mapping stays outside +the claimed three-polynomial form. Criterion 2 avoids the second patent's +`q ≡ 3 (mod 4)` variant, which fixes `Z = -1`. The criteria exclude the +original parameters of the literature —the simplified SWU of Brier et al. +() is the `Z = -1` case, and Wahby–Boneh +() choose `ξ = -1` for BLS12-381— so they +are strictly narrower than what is mathematically necessary, and no proof in +this development depends on them. +-/ + +namespace CompElliptic.Hashing + +open CompElliptic.Fields + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +/-- In a finite field, a nonsquare times a nonsquare is a square: the quadratic +character is multiplicative and takes the value `-1` on exactly the nonsquares, +so the product's character is `(-1)·(-1) = 1`. (In characteristic 2 the +hypothesis `¬ IsSquare a` is vacuous —every element is a square— so no +characteristic assumption is needed.) -/ +theorem isSquare_mul_of_not_isSquare {a b : F} + (ha : ¬ IsSquare a) (hb : ¬ IsSquare b) : IsSquare (a * b) := by + have ha0 : a ≠ 0 := fun h => ha (h ▸ ⟨0, (mul_zero 0).symm⟩) + have hb0 : b ≠ 0 := fun h => hb (h ▸ ⟨0, (mul_zero 0).symm⟩) + have hχa : quadraticChar F a = -1 := quadraticChar_neg_one_iff_not_isSquare.mpr ha + have hχb : quadraticChar F b = -1 := quadraticChar_neg_one_iff_not_isSquare.mpr hb + refine (quadraticChar_one_iff_isSquare (mul_ne_zero ha0 hb0)).mp ?_ + rw [map_mul, hχa, hχb] + ring + +/-- `sqrt_ratio` of protocol spec §5.4.9.8: `(√(num/div), 1)` when `num/div` is +square, else `(√(lam·num/div), 0)` for the fixed nonsquare `lam`. The square +root is the Tonelli–Shanks root; the spec permits any root and any nonsquare +`lam`, and its output-independence note is what licenses fixing them. -/ +def sqrtRatio (d : TonelliShanks F) (lam num div : F) : F × Bool := + match d.sqrt? (num / div) with + | some r => (r, true) + | none => ((d.sqrt? (lam * (num / div))).getD 0, false) + +/-- The `Bool` component of `sqrt_ratio` reports squareness of the ratio. -/ +theorem sqrtRatio_true_iff (d : TonelliShanks F) (lam num div : F) : + (sqrtRatio d lam num div).2 = true ↔ IsSquare (num / div) := by + rcases hs : d.sqrt? (num / div) with _ | r + · simp only [sqrtRatio, hs] + exact iff_of_false (by simp) fun hsq => by + obtain ⟨r, hr⟩ := TonelliShanks.sqrt?_isSome_of_isSquare d hsq + rw [hs] at hr + cases hr + · simp only [sqrtRatio, hs] + exact iff_of_true trivial ⟨r, (TonelliShanks.sqrt?_mul_self d hs).symm⟩ + +/-- In the square case, `sqrt_ratio` returns a square root of the ratio. -/ +theorem sqrtRatio_true_sq (d : TonelliShanks F) {lam num div : F} + (h : (sqrtRatio d lam num div).2 = true) : + (sqrtRatio d lam num div).1 * (sqrtRatio d lam num div).1 = num / div := by + rcases hs : d.sqrt? (num / div) with _ | r + · rw [sqrtRatio, hs] at h ⊢ + cases h + · rw [sqrtRatio, hs] + exact TonelliShanks.sqrt?_mul_self d hs + +/-- In the nonsquare case, `sqrt_ratio` returns a square root of `lam` times the +ratio — never `⊥`, as the spec notes: the ratio is a nonzero nonsquare there, so +multiplying by the nonsquare `lam` makes it a square. -/ +theorem sqrtRatio_false_sq (d : TonelliShanks F) + {lam : F} (hlam : ¬ IsSquare lam) {num div : F} + (h : (sqrtRatio d lam num div).2 = false) : + (sqrtRatio d lam num div).1 * (sqrtRatio d lam num div).1 + = lam * (num / div) := by + rcases hs : d.sqrt? (num / div) with _ | r + · have hns : ¬ IsSquare (num / div) := fun hsq => by + obtain ⟨r, hr⟩ := TonelliShanks.sqrt?_isSome_of_isSquare d hsq + rw [hs] at hr + cases hr + obtain ⟨r, hr⟩ := TonelliShanks.sqrt?_isSome_of_isSquare d + (isSquare_mul_of_not_isSquare hlam hns) + rw [sqrtRatio, hs] + simp only [hr, Option.getD_some] + exact TonelliShanks.sqrt?_mul_self d hr + · rw [sqrtRatio, hs] at h + cases h + +open CompElliptic.CurveForms.ShortWeierstrass in +/-- Parameters for `map_to_curve_simple_swu` onto a curve `E` with `A·B ≠ 0` +(protocol spec §5.4.9.8): the mapping's nonsquare `Z`; the `sqrt_ratio` data +—Tonelli–Shanks square-root data `d` and the arbitrary nonsquare `lam`—; the +precomputed `θ` with `θ²·lam = Z`; and the sign function used by the final +parity-matching step (`sgn0` for the deployed prime fields). + +The record also certifies RFC 9380's four criteria on `Z` +(): criterion 1 is +`Z_nonsquare`, and criteria 2–4 are `crit2`–`crit4`, with `crit3` stated as +root-freeness of `g(X) - Z` (for a cubic, the RFC's irreducibility). The +module documentation records the criteria's roles and the patent-avoidance +provenance of criteria 2 and 3, which no proof consumes. -/ +structure SSWUParams (F : Type*) [Field F] [Fintype F] [DecidableEq F] where + E : SWCurve F + A_nonzero : E.A ≠ 0 + Z : F + Z_nonsquare : ¬ IsSquare Z + d : TonelliShanks F + lam : F + lam_nonsquare : ¬ IsSquare lam + θ : F + θ_spec : θ * θ * lam = Z + sgn : F → Bool + crit2 : Z ≠ -1 + crit3 : ∀ x : F, x ^ 3 + E.A * x + E.B ≠ Z + crit4 : IsSquare ((E.B / (Z * E.A))^3 + E.A * (E.B / (Z * E.A)) + E.B) + +namespace SSWUParams + +open CompElliptic.CurveForms.ShortWeierstrass + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +/-- The nonsquare `Z` is in particular nonzero (zero is a square). -/ +theorem Z_nonzero (G : SSWUParams F) : G.Z ≠ 0 := + fun h => G.Z_nonsquare (h ▸ ⟨0, (mul_zero 0).symm⟩) + +/-- The coordinates of `map_to_curve_simple_swu` before its final step: the +spec's steps with the spec's intermediate names, keeping the candidate ordinate +`y'` that the sign-matching step would overwrite. Splitting the definition here +diverges slightly from the spec's single list, but the composition `mapXY` is +step-for-step the spec's, and the split is what lets the mapping be analysed as +a signed lift (`map_eq_signedLift`). -/ +def mapXYUpToSign (G : SSWUParams F) (u : F) : F × F := + let Zuu := G.Z * u^2 + let ta := Zuu^2 + Zuu + let x1num := G.E.B * (ta + 1) + let xdiv := G.E.A * (if ta = 0 then G.Z else -ta) + let U := (x1num^2 + G.E.A * xdiv^2) * x1num + G.E.B * xdiv^3 + let x2num := Zuu * x1num + let sr := sqrtRatio G.d G.lam U (xdiv^3) + let y1 := sr.1 + let y2 := G.θ * Zuu * u * y1 + let xnum := if sr.2 then x1num else x2num + let y' := if sr.2 then y1 else y2 + (xnum / xdiv, y') + +/-- The coordinates of `map_to_curve_simple_swu` (spec §5.4.9.8): `mapXYUpToSign`, +then the sign-matching step on the candidate ordinate. -/ +def mapXY (G : SSWUParams F) (u : F) : F × F := + let p := G.mapXYUpToSign u + (p.1, if G.sgn p.2 = G.sgn u then p.2 else -p.2) + +/-- **`map_to_curve_simple_swu` lands on the curve** — moreover always on an +affine point, never the identity. See the module docstring for the shape of the +argument. -/ +theorem onCurve_mapXY (G : SSWUParams F) (u : F) : + OnCurve G.E.A G.E.B (G.mapXY u) := by + simp only [mapXY, mapXYUpToSign] + set Zuu := G.Z * u^2 with hZuu + set ta := Zuu^2 + Zuu with hta + set x1num := G.E.B * (ta + 1) with hx1num + set xdiv := G.E.A * (if ta = 0 then G.Z else -ta) with hxdiv + set U := (x1num^2 + G.E.A * xdiv^2) * x1num + G.E.B * xdiv^3 with hU + set x2num := Zuu * x1num with hx2num + set sr := sqrtRatio G.d G.lam U (xdiv^3) with hsr + have hxdiv0 : xdiv ≠ 0 := by + rw [hxdiv] + split_ifs with h + · exact mul_ne_zero G.A_nonzero G.Z_nonzero + · exact mul_ne_zero G.A_nonzero (neg_ne_zero.mpr h) + -- The sign-matching step does not change the square of the ordinate. + have hsign : ∀ y' : F, (if G.sgn y' = G.sgn u then y' else -y')^2 = y'^2 := by + intro y' + split_ifs <;> ring + -- Reduce the curve equation at `xnum/xdiv` to its cleared form. + have hcleared : ∀ xnum y : F, + y^2 * xdiv^3 = xnum^3 + G.E.A * xnum * xdiv^2 + G.E.B * xdiv^3 → + OnCurve G.E.A G.E.B (xnum / xdiv, y) := by + intro xnum y h + unfold OnCurve + field_simp + linear_combination h + by_cases hb : sr.2 + · -- Square branch: the curve equation at `x1num/xdiv` is the definition of `U`. + have h1 : sr.1 * sr.1 = U / xdiv^3 := sqrtRatio_true_sq G.d hb + have h1c : sr.1^2 * xdiv^3 = U := by + rw [sq, h1, div_mul_cancel₀ _ (pow_ne_zero 3 hxdiv0)] + have hx : (if sr.2 then x1num else x2num) = x1num := by simp [hb] + have hy : (if sr.2 then sr.1 else G.θ * Zuu * u * sr.1) = sr.1 := by simp [hb] + rw [hx, hy] + refine hcleared x1num _ ?_ + rw [hsign sr.1, h1c, hU] + ring + · -- Nonsquare branch. + have hbf : sr.2 = false := Bool.eq_false_iff.mpr hb + have h2 : sr.1 * sr.1 = G.lam * (U / xdiv^3) := + sqrtRatio_false_sq G.d G.lam_nonsquare hbf + have h2c : sr.1^2 * xdiv^3 = G.lam * U := by + rw [sq, h2, mul_assoc, div_mul_cancel₀ _ (pow_ne_zero 3 hxdiv0)] + by_cases hta0 : ta = 0 + · -- Exceptional case: criterion 4 makes the ratio a square, contradiction. + exfalso + have hxd : xdiv = G.E.A * G.Z := by rw [hxdiv, if_pos hta0] + have hx1 : x1num = G.E.B := by rw [hx1num, hta0]; ring + have hA : G.E.A ≠ 0 := G.A_nonzero + have hZ : G.Z ≠ 0 := G.Z_nonzero + have hratio : U / xdiv^3 + = (G.E.B / (G.Z * G.E.A))^3 + G.E.A * (G.E.B / (G.Z * G.E.A)) + G.E.B := by + rw [hU, hxd, hx1] + field_simp + have := (sqrtRatio_true_iff G.d G.lam U (xdiv^3)).mpr + (by rw [hratio]; exact G.crit4) + rw [← hsr] at this + exact hb this + · -- Generic case: the `Zuu³` identity closes the algebra. + have hxd : xdiv = G.E.A * -ta := by rw [hxdiv, if_neg hta0] + -- The SSWU identity: special to the choice of `x1num` and `xdiv`. + have hkey : Zuu^3 * U = x2num^3 + G.E.A * x2num * xdiv^2 + G.E.B * xdiv^3 := by + rw [hU, hx2num, hx1num, hxd, hta] + ring + have hx : (if sr.2 then x1num else x2num) = x2num := by simp [hbf] + have hy : (if sr.2 then sr.1 else G.θ * Zuu * u * sr.1) + = G.θ * Zuu * u * sr.1 := by simp [hbf] + rw [hx, hy] + refine hcleared x2num _ ?_ + rw [hsign (G.θ * Zuu * u * sr.1)] + calc (G.θ * Zuu * u * sr.1)^2 * xdiv^3 + = G.θ * G.θ * (Zuu^2 * u^2) * (sr.1^2 * xdiv^3) := by ring + _ = G.θ * G.θ * (Zuu^2 * u^2) * (G.lam * U) := by rw [h2c] + _ = (G.θ * G.θ * G.lam) * (u^2 * Zuu^2 * U) := by ring + _ = G.Z * (u^2 * Zuu^2 * U) := by rw [G.θ_spec] + _ = Zuu^3 * U := by rw [hZuu]; ring + _ = x2num^3 + G.E.A * x2num * xdiv^2 + G.E.B * xdiv^3 := hkey + +/-- `map_to_curve_simple_swu` as a curve point: the coordinates of `mapXY`, +which are on the curve by `onCurve_mapXY`. -/ +def map (G : SSWUParams F) (u : F) : SWPoint G.E := + ⟨(G.mapXY u).1, (G.mapXY u).2, Or.inl (G.onCurve_mapXY u)⟩ + +/-! ## The signed-lift structure of the mapping + +The last step of `mapXY` is RFC 9380's sign matching, which `signedLift` +isolates. Packaging the earlier steps as the candidate point `candidateMap` +exhibits `map` as a signed lift (`map_eq_signedLift`), and oddness away from +`0` follows from `signedLift_neg`: the candidate is even up to the sign +carried by the nonsquare branch's bare factor of `u`. -/ + +/-- The candidate coordinates are representable: `mapXY u` is on the curve, +and its ordinate is the candidate's up to sign, so the squares agree. -/ +theorem valid_pre (G : SSWUParams F) (u : F) : + Valid G.E.A G.E.B (G.mapXYUpToSign u) := by + left + have h : OnCurve G.E.A G.E.B (G.mapXY u) := G.onCurve_mapXY u + have heq : G.mapXY u = ((G.mapXYUpToSign u).1, + if G.sgn (G.mapXYUpToSign u).2 = G.sgn u + then (G.mapXYUpToSign u).2 else -(G.mapXYUpToSign u).2) := rfl + rw [heq] at h + simp only [OnCurve] at h ⊢ + split_ifs at h + · exact h + · rwa [neg_sq] at h + +/-- `mapXYUpToSign`, packaged as a curve point: the candidate that the sign-matching +step corrects. -/ +def candidateMap (G : SSWUParams F) (u : F) : SWPoint G.E := + ⟨(G.mapXYUpToSign u).1, (G.mapXYUpToSign u).2, G.valid_pre u⟩ + +/-- `map` is the signed lift of the candidate `candidateMap`. -/ +theorem map_eq_signedLift (G : SSWUParams F) (u : F) : + G.map u = signedLift G.candidateMap G.sgn u := by + apply SWPoint.ext_pair + rw [show ((G.map u).x, (G.map u).y) = G.mapXY u from rfl] + simp only [signedLift, candidateMap, mapXY] + split_ifs <;> rfl + +/-- The candidate map is even up to sign: the square branch is even in the +input, and the nonsquare branch is odd — its candidate root carries a bare +factor of `u`. -/ +theorem candidateMap_neg (G : SSWUParams F) (u : F) : + G.candidateMap (-u) = G.candidateMap u ∨ G.candidateMap (-u) = -(G.candidateMap u) := by + have hx : (G.candidateMap (-u)).x = (G.candidateMap u).x := by + simp only [candidateMap, mapXYUpToSign, neg_sq] + have hy : (G.candidateMap (-u)).y = (G.candidateMap u).y + ∨ (G.candidateMap (-u)).y = -(G.candidateMap u).y := by + simp only [candidateMap, mapXYUpToSign, neg_sq] + split_ifs <;> first + | exact Or.inl rfl + | exact Or.inr (by ring) + rcases hy with h | h + · exact Or.inl (SWPoint.ext_pair (by rw [hx, h])) + · exact Or.inr (SWPoint.ext_pair + (by rw [SWPoint.neg_x, SWPoint.neg_y, hx, h])) + +/-- The mapping is odd away from `0`, by `signedLift_neg`. -/ +theorem map_neg (G : SSWUParams F) (hsgn : IsSignFunction G.sgn) {u : F} + (hu : u ≠ 0) : G.map (-u) = -(G.map u) := by + rw [map_eq_signedLift, map_eq_signedLift] + exact signedLift_neg G.candidateMap_neg hsgn hu + +end SSWUParams + +end CompElliptic.Hashing diff --git a/CompElliptic/Hashing/TwoTermUniformity.lean b/CompElliptic/Hashing/TwoTermUniformity.lean new file mode 100644 index 0000000..808ade6 --- /dev/null +++ b/CompElliptic/Hashing/TwoTermUniformity.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Hashing.WellDistributed +import Mathlib.Analysis.Fourier.FiniteAbelian.PontryaginDuality +import Mathlib.Algebra.Order.BigOperators.Ring.Finset + +/-! +# Two-term hash uniformity from character sums + +The hash-to-curve construction deployed for the Pasta curves computes +`m ↦ f (h₁ m) + f (h₂ m)`: hash to two field elements, map each through `f` to +a curve point, and add the two points. A single evaluation of `f` is visibly +non-uniform (its image covers only a constant fraction of the curve), so the +construction sums two independent copies. This file proves that the repair works: +if all the nontrivial "character sums" of `f` are small —the `WeilBounded` +hypothesis— then the two-term output distribution is within a small statistical +distance of uniform on the whole group. + +## Characters, for readers who know the DFT + +The DFT analyzes a signal on `ℤ/N` against the reference waves +`a ↦ exp (2πi·k·a/N)`, one per frequency `k`. What makes those waves work is not +anything analytic about the exponential — it is the identity +`exp(2πi·k·(a+b)/N) = exp(2πi·k·a/N) · exp(2πi·k·b/N)`, which turns addition of +signal positions into multiplication of wave values. A **character** of a finite +abelian group `G` keeps exactly that property and discards the rest: it is a map +`ψ : G → ℂ` with `ψ (a + b) = ψ a * ψ b` (so `ψ 0 = 1`, and every value is a root +of unity, hence on the unit circle). Mathlib packages these as `AddChar G ℂ`. +For `G = ℤ/N` the characters are precisely the `N` reference waves of the DFT; +for a general finite abelian `G` there are exactly `#G` of them +(`AddChar.card_eq`), and they support the same Fourier toolkit. Two facts carry +the whole file, and both are the finite-group forms of facts commonly used with +the DFT: + +* **Orthogonality**: summing a nontrivial wave over a full period gives zero. +* **Parseval**: total energy is the same whether you sum squares in the signal + domain or in the frequency domain. + +Elliptic-curve points under point addition are a finite abelian group, so all of +this applies to them directly; no geometry enters this file. + +## The pipeline + +`pairCount f Q` counts pairs `(u₀, u₁)` with `f u₀ + f u₁ = Q`. Dividing by +`(#F)²` gives the probability that the two-term hash outputs `Q`, so uniformity +means `pairCount` is close to the constant `(#F)²/#G`. The proofs mirror the +standard DFT pipeline for analyzing a convolution — the distribution of a sum of +independent variables is a convolution, and convolution in the signal domain is +multiplication in the frequency domain: + +* `sum_addChar_apply` (orthogonality over frequencies): `∑ ψ, ψ a` is `#G` when + `a = 0` and `0` otherwise. This is the "delta function as a sum of waves" + identity underlying Fourier inversion. +* `card_mul_pairCount` (the Fourier expansion): the transform of `pairCount` at + frequency `ψ` is the square of `S ψ := ∑ u, ψ (f u)` — squared because the two + inputs are independent, exactly as convolving a signal with itself squares its + spectrum. +* `card_mul_sum_sq_pairCount` (Parseval): `#G * ∑ Q, (pairCount f Q)² = + ∑ ψ, ‖S ψ‖⁴`. Note this identity consumes no Weil bound: it is the exact + second moment of the output distribution, valid for every `f`. +* `sum_sq_dev_le`: feeding `WeilBounded f C` into Parseval bounds the summed + squared deviation of `pairCount` from its uniform value. The trivial character + contributes the main term and is removed exactly; each of the `#G - 1` + nontrivial frequencies contributes at most `(C²·#F)²`. +* `sq_sum_abs_dev_le` and `sq_sum_abs_prob_dev_le`: Cauchy–Schwarz converts the + squared-deviation bound into (the square of) the L¹ deviation — twice the + statistical distance. In the deployed setting `#G ≈ #F = q ≈ 2^{254}` and the + constant expected from FFSTV is `C ≈ 52`, making the statistical distance + about `C²/√q ≈ 2^{-116}`. That figure relies on the `WeilBounded` hypothesis: + established mathematics, but an unformalized input here (see + `WellDistributed.lean`). + +Everything here is stated for an arbitrary function `f : F → G` from a finite +type into a finite abelian group; oddness of the mapping and the elliptic curve +itself play no role in this file (they enter upstream, in `CharacterSum.lean`, +where the Weil-bound hypothesis is connected to the sign-free geometry). +-/ + +namespace CompElliptic.Hashing + +open Finset +open scoped ComplexConjugate + +variable {F : Type*} [Fintype F] +variable {G : Type*} [AddCommGroup G] [Fintype G] [DecidableEq G] + +/-- `pairCount f Q` is the number of input pairs `(u₀, u₁)` with +`f u₀ + f u₁ = Q` — the unnormalized distribution of the two-term hash output +`f u₀ + f u₁` for independent uniform inputs. Dividing by `(#F)²` gives the +probability of the output `Q`; uniformity means `pairCount f` is close to the +constant `(#F)²/#G`. -/ +def pairCount (f : F → G) (Q : G) : ℕ := + (univ.filter fun p : F × F => f p.1 + f p.2 = Q).card + +/-- The pair counts total `(#F)²`: every pair lands somewhere. -/ +theorem sum_pairCount (f : F → G) : + ∑ Q, pairCount f Q = (Fintype.card F)^2 := by + classical + have h := Finset.card_eq_sum_card_fiberwise + (f := fun p : F × F => f p.1 + f p.2) (s := univ) (t := univ) + (fun p _ => mem_univ _) + simpa [pairCount, Finset.card_univ, Fintype.card_prod, sq] using h.symm + +/-- **Orthogonality over frequencies.** Summing every character at a fixed point +`a` detects whether `a = 0`: the sum is `#G` at `a = 0` (all waves read `1` +there) and `0` elsewhere. This is the finite-group form of "a delta function is +the average of all reference waves", the identity behind Fourier inversion. + +The proof is a neat self-application: `a` evaluates characters, so `a` *is* a +character of the character group (`AddChar.doubleDualEmb`), and the sum over the +dual group is handled by the same one-line trick that proves orthogonality over +the group itself (`AddChar.sum_eq_ite`). Pontryagin duality supplies the two +facts that make the answer come out right: evaluation at `a ≠ 0` is a nontrivial +character of the dual (`AddChar.doubleDualEmb_injective`), and the dual has +exactly `#G` elements (`AddChar.card_eq`). -/ +theorem sum_addChar_apply (a : G) : + ∑ ψ : AddChar G ℂ, ψ a = if a = 0 then (Fintype.card G : ℂ) else 0 := by + classical + rw [Finset.sum_congr rfl fun ψ _ => (AddChar.doubleDualEmb_apply a ψ).symm, + AddChar.sum_eq_ite] + by_cases ha : a = 0 + · rw [if_pos (by rw [ha]; exact map_zero _), if_pos ha, AddChar.card_eq] + · rw [if_neg (fun h0 => ha (AddChar.doubleDualEmb_injective + (h0.trans (map_zero _).symm))), if_neg ha] + +/-- **The Fourier expansion of the pair count.** The distribution of a sum of two +independent variables is a convolution, and convolution in the signal domain is +multiplication in the frequency domain — here the two summands are identically +distributed, so the transform of `pairCount f` at frequency `ψ` is the *square* +of the single-copy character sum `S ψ = ∑ u, ψ (f u)`. Concretely: + +`#G * pairCount f Q = ∑ ψ, ψ (-Q) * (S ψ)²`. + +This squaring is the entire reason the deployed hash sums two independent +copies: whatever bound the nontrivial `S ψ` satisfy, the two-term construction +satisfies its square. -/ +theorem card_mul_pairCount (f : F → G) (Q : G) : + (Fintype.card G : ℂ) * pairCount f Q + = ∑ ψ : AddChar G ℂ, ψ (-Q) * (∑ u, ψ (f u))^2 := by + classical + have expand : ∀ ψ : AddChar G ℂ, + ψ (-Q) * (∑ u, ψ (f u))^2 = ∑ p : F × F, ψ (f p.1 + f p.2 - Q) := by + intro ψ + rw [sq, Finset.sum_mul_sum, ← Finset.univ_product_univ, Finset.sum_product, + Finset.mul_sum] + refine Finset.sum_congr rfl fun u₀ _ => ?_ + rw [Finset.mul_sum] + refine Finset.sum_congr rfl fun u₁ _ => ?_ + rw [sub_eq_add_neg, AddChar.map_add_eq_mul, AddChar.map_add_eq_mul] + ring + rw [Finset.sum_congr rfl fun ψ _ => expand ψ, Finset.sum_comm] + have inner : ∀ p : F × F, + ∑ ψ : AddChar G ℂ, ψ (f p.1 + f p.2 - Q) + = if f p.1 + f p.2 = Q then (Fintype.card G : ℂ) else 0 := by + intro p + rw [sum_addChar_apply] + simp only [sub_eq_zero] + rw [Finset.sum_congr rfl fun p _ => inner p, ← Finset.sum_filter, + Finset.sum_const, nsmul_eq_mul, pairCount, mul_comm] + +/-- **Parseval, a.k.a. the second moment of the output distribution.** Energy can +be computed in either domain: `#G` times the sum of the squared pair counts +equals the sum over all frequencies of `‖S ψ‖⁴`. (In additive-combinatorics +language, the left-hand side is `#G` times the *additive energy* of `f`.) + +This identity involves no Weil bound and no hypothesis on `f` whatsoever — it is +exact bookkeeping, and it already gives the *average* size of the nontrivial +`‖S ψ‖`: everything the curve's group order can say about uniformity is +contained here. What it cannot give is a bound on the *worst* frequency, which +is what the statistical-distance estimate needs and what `WeilBounded` +supplies. -/ +theorem card_mul_sum_sq_pairCount (f : F → G) : + (Fintype.card G : ℝ) * ∑ Q, (pairCount f Q : ℝ)^2 + = ∑ ψ : AddChar G ℂ, ‖∑ u, ψ (f u)‖^4 := by + classical + -- Cross-frequency orthogonality: distinct waves cancel over the group. + have ortho : ∀ ψ φ : AddChar G ℂ, + ∑ Q, ψ (-Q) * conj (φ (-Q)) = if φ = ψ then (Fintype.card G : ℂ) else 0 := by + intro ψ φ + have step : ∀ Q : G, ψ (-Q) * conj (φ (-Q)) = (φ - ψ) Q := by + intro Q + rw [AddChar.map_neg_eq_conj φ, Complex.conj_conj, AddChar.sub_apply, + AddChar.map_neg_eq_inv] + ring + rw [Finset.sum_congr rfl fun Q _ => step Q, AddChar.sum_eq_ite] + simp [sub_eq_zero] + -- Expand `(#G · pairCount)·conj(#G · pairCount)` through the Fourier expansion + -- and collapse the double frequency sum with `ortho`. + have key : (Fintype.card G : ℂ)^2 * ∑ Q, (pairCount f Q : ℂ)^2 + = (Fintype.card G : ℂ) + * ∑ ψ : AddChar G ℂ, (∑ u, ψ (f u))^2 * conj ((∑ u, ψ (f u))^2) := by + calc (Fintype.card G : ℂ)^2 * ∑ Q, (pairCount f Q : ℂ)^2 + = ∑ Q, ((Fintype.card G : ℂ) * pairCount f Q) + * conj ((Fintype.card G : ℂ) * pairCount f Q) := by + rw [Finset.mul_sum] + refine Finset.sum_congr rfl fun Q _ => ?_ + have : conj ((Fintype.card G : ℂ) * pairCount f Q) + = (Fintype.card G : ℂ) * pairCount f Q := by simp + rw [this]; ring + _ = ∑ Q, (∑ ψ : AddChar G ℂ, ψ (-Q) * (∑ u, ψ (f u))^2) + * conj (∑ φ : AddChar G ℂ, φ (-Q) * (∑ u, φ (f u))^2) := by + refine Finset.sum_congr rfl fun Q _ => ?_ + rw [card_mul_pairCount] + _ = ∑ ψ : AddChar G ℂ, ∑ φ : AddChar G ℂ, + ((∑ u, ψ (f u))^2 * conj ((∑ u, φ (f u))^2)) + * ∑ Q, ψ (-Q) * conj (φ (-Q)) := by + simp_rw [map_sum, Finset.sum_mul_sum, map_mul, Finset.mul_sum] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun ψ _ => Finset.sum_comm.trans ?_ + refine Finset.sum_congr rfl fun φ _ => ?_ + exact Finset.sum_congr rfl fun Q _ => by ring + _ = (Fintype.card G : ℂ) + * ∑ ψ : AddChar G ℂ, (∑ u, ψ (f u))^2 * conj ((∑ u, ψ (f u))^2) := by + simp_rw [ortho] + rw [Finset.mul_sum] + refine Finset.sum_congr rfl fun ψ _ => ?_ + simp_rw [mul_ite, mul_zero] + rw [Finset.sum_ite_eq' univ ψ] + simp only [mem_univ, if_true] + ring + -- Take the identity down to `ℝ`. + have cast_lhs : (Fintype.card G : ℂ)^2 * ∑ Q, (pairCount f Q : ℂ)^2 + = ((Fintype.card G : ℝ)^2 * ∑ Q, (pairCount f Q : ℝ)^2 : ℝ) := by + push_cast; ring + have cast_rhs : (Fintype.card G : ℂ) + * ∑ ψ : AddChar G ℂ, (∑ u, ψ (f u))^2 * conj ((∑ u, ψ (f u))^2) + = ((Fintype.card G : ℝ) * ∑ ψ : AddChar G ℂ, ‖∑ u, ψ (f u)‖^4 : ℝ) := by + push_cast + rw [Finset.mul_sum, Finset.mul_sum] + refine Finset.sum_congr rfl fun ψ _ => ?_ + rw [Complex.mul_conj'] + norm_cast + rw [norm_pow] + ring + rw [cast_lhs, cast_rhs] at key + have real_eq := Complex.ofReal_injective key + have hG : (Fintype.card G : ℝ) ≠ 0 := + Nat.cast_ne_zero.2 (Fintype.card_pos_iff.2 ⟨0⟩).ne' + refine mul_left_cancel₀ hG ?_ + rw [← mul_assoc, ← sq] + exact real_eq + +/-- **The squared deviation from uniform, bounded.** Feeding the Weil bound into +Parseval: the trivial character's contribution to the second moment is exactly the +uniform main term and cancels, and each of the `#G - 1` nontrivial frequencies +contributes at most `(C²·#F)²` — the square coming from the two-term +construction. What remains is the summed squared deviation of the (scaled) pair +counts from their uniform value `(#F)²/#G`: + +`∑ Q, (#G·pairCount f Q - (#F)²)² ≤ #G·(#G - 1)·(C²·#F)²`. + +Dividing through by `(#G·(#F)²)²` reads this as: the output distribution is +within L² distance about `C²/(#F·√#G)` of uniform. -/ +theorem sum_sq_dev_le (f : F → G) {C : ℝ} (h : WeilBounded f C) : + ∑ Q, ((Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2)^2 + ≤ (Fintype.card G : ℝ) * ((Fintype.card G : ℝ) - 1) + * (C^2 * Fintype.card F)^2 := by + classical + have hsum : ∑ Q, (pairCount f Q : ℝ) = (Fintype.card F : ℝ)^2 := by + exact_mod_cast sum_pairCount f + -- Expand the square and collapse the cross term with `hsum`. + have expand : ∑ Q, ((Fintype.card G : ℝ) * pairCount f Q + - (Fintype.card F : ℝ)^2)^2 + = (Fintype.card G : ℝ)^2 * ∑ Q, (pairCount f Q : ℝ)^2 + - (Fintype.card G : ℝ) * (Fintype.card F : ℝ)^4 := by + have step : ∀ Q : G, ((Fintype.card G : ℝ) * pairCount f Q + - (Fintype.card F : ℝ)^2)^2 + = (Fintype.card G : ℝ)^2 * (pairCount f Q : ℝ)^2 + - 2 * (Fintype.card F : ℝ)^2 * (Fintype.card G : ℝ) + * (pairCount f Q : ℝ) + + (Fintype.card F : ℝ)^4 := fun Q => by ring + rw [Finset.sum_congr rfl fun Q _ => step Q, Finset.sum_add_distrib, + Finset.sum_sub_distrib, ← Finset.mul_sum, ← Finset.mul_sum, hsum, + Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + ring + -- Parseval, with the trivial frequency split off. + have parseval := card_mul_sum_sq_pairCount f + have split : ∑ ψ : AddChar G ℂ, ‖∑ u, ψ (f u)‖^4 + = (Fintype.card F : ℝ)^4 + + ∑ ψ ∈ univ.erase (1 : AddChar G ℂ), ‖∑ u, ψ (f u)‖^4 := by + rw [← Finset.add_sum_erase univ _ (mem_univ (1 : AddChar G ℂ))] + congr 1 + simp + -- Each nontrivial frequency obeys the (squared) Weil bound. + have bound : ∑ ψ ∈ univ.erase (1 : AddChar G ℂ), ‖∑ u, ψ (f u)‖^4 + ≤ ((Fintype.card G : ℝ) - 1) * (C^2 * Fintype.card F)^2 := by + have each : ∀ ψ ∈ univ.erase (1 : AddChar G ℂ), + ‖∑ u, ψ (f u)‖^4 ≤ (C^2 * Fintype.card F)^2 := by + intro ψ hψ + have h2 := h ψ (Finset.mem_erase.mp hψ).1 + calc ‖∑ u, ψ (f u)‖^4 = (‖∑ u, ψ (f u)‖^2)^2 := by ring + _ ≤ (C^2 * Fintype.card F)^2 := by gcongr + calc ∑ ψ ∈ univ.erase (1 : AddChar G ℂ), ‖∑ u, ψ (f u)‖^4 + ≤ (univ.erase (1 : AddChar G ℂ)).card • (C^2 * Fintype.card F)^2 := + Finset.sum_le_card_nsmul _ _ _ each + _ = ((Fintype.card G : ℝ) - 1) * (C^2 * Fintype.card F)^2 := by + rw [Finset.card_erase_of_mem (mem_univ _), Finset.card_univ, + AddChar.card_eq, nsmul_eq_mul, Nat.cast_sub Fintype.card_pos] + norm_num + -- Combine: the deviation is `#G` times the nontrivial part of the spectrum. + have collapse : ∑ Q, ((Fintype.card G : ℝ) * pairCount f Q + - (Fintype.card F : ℝ)^2)^2 + = (Fintype.card G : ℝ) + * ∑ ψ ∈ univ.erase (1 : AddChar G ℂ), ‖∑ u, ψ (f u)‖^4 := by + rw [expand, sq, mul_assoc, parseval, split] + ring + rw [collapse, mul_assoc] + exact mul_le_mul_of_nonneg_left bound (by positivity) + +/-- **The L¹ deviation, squared, via Cauchy–Schwarz.** The statistical distance of +the two-term output from uniform is half the L¹ deviation of the probabilities; +this bounds the square of the (scaled) L¹ deviation, avoiding any square root. -/ +theorem sq_sum_abs_dev_le (f : F → G) {C : ℝ} (h : WeilBounded f C) : + (∑ Q, |(Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2|)^2 + ≤ (Fintype.card G : ℝ)^2 * ((Fintype.card G : ℝ) - 1) + * (C^2 * Fintype.card F)^2 := by + classical + have cs := Finset.sum_mul_sq_le_sq_mul_sq univ + (fun Q => |(Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2|) + (fun _ => 1) + simp only [mul_one, one_pow, Finset.sum_const, Finset.card_univ, + nsmul_eq_mul, sq_abs] at cs + calc (∑ Q, |(Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2|)^2 + ≤ (∑ Q, ((Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2)^2) + * (Fintype.card G : ℝ) := cs + _ ≤ ((Fintype.card G : ℝ) * ((Fintype.card G : ℝ) - 1) + * (C^2 * Fintype.card F)^2) * (Fintype.card G : ℝ) := by + have := sum_sq_dev_le f h + gcongr + _ = (Fintype.card G : ℝ)^2 * ((Fintype.card G : ℝ) - 1) + * (C^2 * Fintype.card F)^2 := by ring + +/-- **The headline: statistical distance from uniform, squared.** In probability +form, `pairCount f Q / (#F)²` is the chance the two-term hash outputs `Q`, and +`1/#G` is the uniform chance, so the total variation distance is half of +`∑ Q, |probability - uniform|`. This theorem bounds that sum's square by +`(#G - 1)·C⁴/(#F)²`. For the deployed parameters (`#G ≈ #F = q ≈ 2^{254}`, with +`C ≈ 52` the constant expected from FFSTV for the hypothesis `h`) the +statistical distance is about `C²/√q ≈ 2^{-116}`. The two-term hash output is +therefore indistinguishable from a uniformly random group element up to that +error, which is the quantitative content of "the construction repairs the +non-uniformity of a single evaluation of `f`". -/ +theorem sq_sum_abs_prob_dev_le [Nonempty F] (f : F → G) {C : ℝ} + (h : WeilBounded f C) : + (∑ Q, |(pairCount f Q : ℝ) / (Fintype.card F : ℝ)^2 + - 1 / (Fintype.card G : ℝ)|)^2 + ≤ ((Fintype.card G : ℝ) - 1) * C^4 / (Fintype.card F : ℝ)^2 := by + classical + have hF : (0 : ℝ) < Fintype.card F := by exact_mod_cast Fintype.card_pos + have hG : (0 : ℝ) < Fintype.card G := by exact_mod_cast Fintype.card_pos + have rewrite : ∀ Q : G, |(pairCount f Q : ℝ) / (Fintype.card F : ℝ)^2 + - 1 / (Fintype.card G : ℝ)| + = |(Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2| + / ((Fintype.card G : ℝ) * (Fintype.card F : ℝ)^2) := by + intro Q + rw [show (pairCount f Q : ℝ) / (Fintype.card F : ℝ)^2 + - 1 / (Fintype.card G : ℝ) + = ((Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2) + / ((Fintype.card G : ℝ) * (Fintype.card F : ℝ)^2) from by + field_simp] + rw [abs_div] + all_goals rw [abs_of_pos (show (0 : ℝ) + < (Fintype.card G : ℝ) * (Fintype.card F : ℝ)^2 by positivity)] + rw [Finset.sum_congr rfl fun Q _ => rewrite Q, ← Finset.sum_div, div_pow, + div_le_div_iff₀ (by positivity) (by positivity)] + calc (∑ Q, |(Fintype.card G : ℝ) * pairCount f Q - (Fintype.card F : ℝ)^2|)^2 + * (Fintype.card F : ℝ)^2 + ≤ ((Fintype.card G : ℝ)^2 * ((Fintype.card G : ℝ) - 1) + * (C^2 * Fintype.card F)^2) * (Fintype.card F : ℝ)^2 := by + have := sq_sum_abs_dev_le f h + gcongr + _ = ((Fintype.card G : ℝ) - 1) * C^4 + * ((Fintype.card G : ℝ) * (Fintype.card F : ℝ)^2)^2 := by ring + +end CompElliptic.Hashing diff --git a/CompElliptic/Hashing/WellDistributed.lean b/CompElliptic/Hashing/WellDistributed.lean new file mode 100644 index 0000000..6604890 --- /dev/null +++ b/CompElliptic/Hashing/WellDistributed.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.Hashing.CharacterSum + +/-! +# Well-distributed mappings and the Weil bound as an external input + +A mapping `f : F → G` (from a finite field `F` to a finite abelian group `G`) is +*well-distributed* when its nontrivial character sums are small: `‖∑ u, ψ (f u)‖` +is `O(√#F)` for every nontrivial character `ψ`. Well-distributedness is what makes +a two-term hash `m ↦ f (h₁ m) + f (h₂ m)` statistically close to uniform on `G`. +That regularity is one ingredient of indifferentiability from a random oracle +into `G` — the mathematically deep one. The remaining ingredient, an efficient +preimage simulator, is tracked in . +The inner hash (`h₁`, `h₂`, the two `hash_to_field` outputs) stays abstract +throughout, modelled as a random oracle: only its type matters to the +formalization. + +`CharacterSum.lean` reduces that character sum, for the odd mappings used in +hash-to-curve, to the sign-free covering-multiplicity deviation `mult f · - 1`, +using only group orthogonality. The one remaining ingredient —the actual bound +`‖∑ u, ψ (f u)‖ ≤ C·√#F`— is the Weil bound, and it is a genuine external input. +We state it as the hypothesis `WeilBounded` below rather than proving it. + +## Why the Weil bound is not the target curve's order + +It is tempting to hope that `#G` —the order of the target elliptic curve, which +CompElliptic pins exactly and elementarily (`CurveOrder`)— supplies this bound. +It does not, for four reasons that compound. + +1. **It is a bound on a different curve.** The character sum `∑ u, ψ (f u)` equals, + up to `O(1)`, a character sum over the *covering curve* `C` attached to the + mapping (for simplified SWU, of genus 8). Its size is governed by Hasse–Weil + for `C` (`|#C(F) - (#F + 1)| ≤ 2·genus·√#F`), not by the order of the target + curve `E`. The order of `E` does not determine the order of `C`. + +2. **One order is not a uniform family bound.** Well-distributedness needs the + bound to hold *uniformly over every nontrivial character* `ψ`, i.e. over roughly + `#G` distinct twists of the covering, each its own curve. Weil delivers that + uniformity as a theorem. A single point count is one number, not a bound on a + family of size `≈ #G`. + +3. **CompElliptic's order method is special to near-prime-order elliptic curves.** + `CurveOrder` pins `#E` from a prime-order witness (`r • P = 0`) plus the fibre + bound `#E ≤ 2·#F + 1`. For a genus-8 curve the group to count is its Jacobian + (the curve's own points carry no group law; the Jacobian's degree-0 divisor + classes do, with the curve embedded in it), and that group has composite order + `≈ (#F)⁸` — no prime to pin, which is the decisive obstruction. And the fibre + bound is only good to a factor of about two, whereas the character sum needs + `√#F`-precision — a far finer target than "pin to a prime". So the elementary + method does not transfer. + +4. **Jacobian arithmetic is necessary but not sufficient.** Even implementing the + Jacobian's group operations (which we do not), there is no witness-plus-fibre + shortcut at genus 8, and direct point counting over a field of size `≈ 2^{254}` + is infeasible (no verified higher-genus counting algorithm; the naive count is + `≈ 2^{254}` points). Off-line tools (e.g. Sage) can in principle count Jacobian + points, but the result is one order, not the uniform family bound of (2), and + using it in a proof would still require the Riemann-hypothesis-for-curves + machinery that connects point counts to character sums — exactly the theorem + being assumed. + +So the Weil bound (the Riemann hypothesis for curves) enters exactly once, as the +hypothesis below. Everything upstream of it —the removal of the sign convention— +is the elementary, orthogonality-only content of `CharacterSum.lean`. + +## References + +- A. Weil, "Sur les courbes algébriques et les variétés qui s'en déduisent", + Actualités Scientifiques et Industrielles 1041, Hermann, Paris, 1948. + (The Riemann + hypothesis for curves over finite fields, from which both the point-count bound + `|#C(F) - (#F + 1)| ≤ 2·genus·√#F` and the character-sum form below follow.) +- R. R. Farashahi, P.-A. Fouque, I. E. Shparlinski, M. Tibouchi, and J. F. Voloch, + "Indifferentiable deterministic hashing to elliptic and hyperelliptic curves", IACR + Cryptology ePrint Archive, Report 2010/539, + (later published in Mathematics of Computation 82 (2013), pp. 491–512). Lemma 1 is + the character-sum form intended to discharge `WeilBounded`: for a nontrivial Artin + character `χ` of conductor `𝔣` on a curve `X` of genus `g` over a field of size `q`, + `|∑_{P ∈ X(F)} χ(P)| ≤ (2g − 2 + deg 𝔣(χ))·√q`. Theorem 3 is its workhorse form for + encodings presented by a covering `C → E`. Theorem 6 instantiates it for the + simplified SWU encoding (genus-8 covering, `|S_f(χ)| ≤ 52·√q + 151`, stated there + for fields of size `≡ 3 (mod 4)`). The Pasta base fields have size `≡ 1 (mod 4)`, + so the deployed generalized variant needs the same genus computation redone for + its covering; that redo is routine but does not seem to be covered in the + literature. Separately, `WeilBounded` itself is an external input to the + formalization. +-/ + +namespace CompElliptic.Hashing + +open Finset + +variable {F : Type*} [AddCommGroup F] [Fintype F] [DecidableEq F] +variable {G : Type*} [AddCommGroup G] [Fintype G] [DecidableEq G] + +/-- The Weil bound for a mapping `f : F → G`, in squared (exact-arithmetic) form: +every nontrivial character sum satisfies `‖∑ u, ψ (f u)‖² ≤ C²·#F`, the squared form +of `‖∑ u, ψ (f u)‖ ≤ C·√#F`. Squaring keeps the statement in exact real arithmetic +and avoids `Real.sqrt` (which is exact but noncomputable). This is the sole external +input —Hasse–Weil for the mapping's covering curve— that well-distributedness +rests on; see the module docstring for why it is not the target curve's order. -/ +def WeilBounded (f : F → G) (C : ℝ) : Prop := + ∀ ψ : AddChar G ℂ, ψ ≠ 1 → ‖∑ u, ψ (f u)‖^2 ≤ C^2 * (Fintype.card F : ℝ) + +omit [AddCommGroup F] [DecidableEq F] in +/-- The Weil bound, restated through the sign-convention-free reduction of +`charSum_eq`: it is equivalently a bound on the covering-multiplicity deviation +`mult f · - 1`. This is the form downstream uniformity estimates consume. -/ +theorem WeilBounded.deviation {f : F → G} {C : ℝ} (h : WeilBounded f C) + (ψ : AddChar G ℂ) (hψ : ψ ≠ 1) : + ‖∑ Q, ((mult f Q : ℂ) - 1) * ψ Q‖^2 ≤ C^2 * (Fintype.card F : ℝ) := by + rw [← charSum_eq hψ]; exact h ψ hψ + +end CompElliptic.Hashing diff --git a/CompElliptic/Isogenies/Homomorphism.lean b/CompElliptic/Isogenies/Homomorphism.lean new file mode 100644 index 0000000..da80d8d --- /dev/null +++ b/CompElliptic/Isogenies/Homomorphism.lean @@ -0,0 +1,565 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.CurveOrder +import CompElliptic.Isogenies.ThreeIsogeny +import CompElliptic.Isogenies.VeluCertificates + +/-! +# The homomorphism property of the 3-isogeny + +This module proves that `ThreeIsogeny.map` is a group homomorphism on rational +points (`map_add`). That an isogeny is automatically a group homomorphism is a +standard fact (Galbraith §25.1; Silverman, Theorem III.4.8), but Mathlib does +not have the general theorem, and this development does not rely on it: the +property is proved directly for the particular isogeny maps in use. + +The proof is layered. The coordinate-level theorems `chord_x_compat` and +`tangent_x_compat` say that the image of a sum's third point has exactly the +abscissa the codomain group law computes from the two image points. They consume +the generated certificates and support lemmas of `Isogenies/VeluCertificates.lean`, +and their parameters are pinned by defining equations so that the point-level +layer can instantiate them against the branches of `add`. The point level then +assembles `map_add_x` (abscissa agreement for every pair of points), upgrades it +to `map_add_pm` (agreement up to sign, because two on-curve points sharing an +abscissa are equal or negatives), and resolves the sign by group algebra. The +ambiguous cases force an element of order two, and the codomain has none — +rational 2-torsion needs a point with `y = 0`, which `hc` already excludes +(`map_add`, through `eq_zero_of_two_nsmul_eq_zero`). Negation-compatibility +(`map_neg`) carries the sentinel cases. +-/ + +open CompElliptic.CurveForms.ShortWeierstrass CompElliptic.CurveOrder + +namespace CompElliptic.Isogenies.ThreeIsogeny + +variable {F : Type*} [Field F] (I : ThreeIsogeny F) + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- Chord compatibility at the coordinate level: for two on-curve points with +distinct abscissas, the image of the chord's third point has exactly the abscissa +the codomain chord computes from the two image points. The parameters `lam`, `x₃`, +`y₃` are pinned by defining equations, so a caller can instantiate them with the +chord branch of `add`; the caller supplies `h₃` (the third point is on the curve, +from closure of point addition). Consumes the generated certificate and support +lemmas of `Isogenies/VeluCertificates.lean`. -/ +theorem chord_x_compat (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + {x₁ y₁ x₂ y₂ lam x₃ y₃ : F} + (h₁ : OnCurve I.domain.A I.domain.B (x₁, y₁)) + (h₂ : OnCurve I.domain.A I.domain.B (x₂, y₂)) + (h₃ : OnCurve I.domain.A I.domain.B (x₃, y₃)) + (hne : x₁ ≠ x₂) + (hlam : lam = (y₂ - y₁) / (x₂ - x₁)) + (hx₃ : x₃ = lam ^ 2 - x₁ - x₂) + (hy₃ : y₃ = lam * (x₁ - x₃) - y₁) : + (I.mapXY x₃ y₃).1 = + (((I.mapXY x₂ y₂).2 - (I.mapXY x₁ y₁).2) + / ((I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1)) ^ 2 + - (I.mapXY x₁ y₁).1 - (I.mapXY x₂ y₂).1 := by + have hdd : x₁ - x₂ ≠ 0 := sub_ne_zero.mpr hne + have hxx : x₂ - x₁ ≠ 0 := sub_ne_zero.mpr (Ne.symm hne) + have hd₁ : x₁ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₁) + have hd₂ : x₂ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₂) + have hd₃ : x₃ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₃) + have hc₁ : y₁ ^ 2 = x₁ ^ 3 + I.domain.A * x₁ + I.domain.B := h₁ + have hc₂ : y₂ ^ 2 = x₂ ^ 3 + I.domain.A * x₂ + I.domain.B := h₂ + have hslope : y₂ - y₁ = lam * (x₂ - x₁) := by + rw [hlam, div_mul_cancel₀ _ hxx] + set m' : F := y₁ - lam * (x₁ - I.x₀) with hm' + have hL1 : y₁ = lam * (x₁ - I.x₀) + m' := by linear_combination -hm' + have hL2 : y₂ = lam * (x₂ - I.x₀) + m' := by linear_combination hslope - hm' + have hbridge := chord_psi3_bridge ((x₁ - I.x₀) + (x₂ - I.x₀)) (x₁ - x₂) lam m' I.x₀ + I.domain.A I.domain.B + (by linear_combination 8 * hc₁ - 8 * (y₁ + lam * (x₁ - I.x₀) + m') * hL1) + (by linear_combination 8 * hc₂ - 8 * (y₂ + lam * (x₂ - I.x₀) + m') * hL2) + I.psi3 + have hp_inst := (mul_eq_zero.mp hbridge).resolve_left + (mul_ne_zero hdd (pow_ne_zero 1 h2)) + have h2p4 : ((2 : F)^4) ≠ 0 := pow_ne_zero _ h2 + have h2p6 : ((2 : F)^6) ≠ 0 := pow_ne_zero _ h2 + have hsem_ns := chord_ns_semantics ((x₁ - I.x₀) + (x₂ - I.x₀)) (x₁ - x₂) lam m' I.x₀ + I.domain.A I.domain.B + (by linear_combination 8 * hc₁ - 8 * (y₁ + lam * (x₁ - I.x₀) + m') * hL1) + (by linear_combination 8 * hc₂ - 8 * (y₂ + lam * (x₂ - I.x₀) + m') * hL2) + have hsem_ws := chord_ws_semantics ((x₁ - I.x₀) + (x₂ - I.x₀)) (x₁ - x₂) lam m' I.x₀ + I.domain.A I.domain.B + (by linear_combination 8 * hc₁ - 8 * (y₁ + lam * (x₁ - I.x₀) + m') * hL1) + (by linear_combination 8 * hc₂ - 8 * (y₂ + lam * (x₂ - I.x₀) + m') * hL2) + obtain ⟨nsv, hnsv⟩ : ∃ n : F, + n = (I.xnum x₂ * (x₁ - I.x₀) ^ 2 - I.xnum x₁ * (x₂ - I.x₀) ^ 2) / (x₁ - x₂) := ⟨_, rfl⟩ + obtain ⟨wsv, hwsv⟩ : ∃ w : F, + w = ((lam * (x₂ - I.x₀) + m') * I.ynum x₂ * (x₁ - I.x₀) ^ 3 + - (lam * (x₁ - I.x₀) + m') * I.ynum x₁ * (x₂ - I.x₀) ^ 3) / (x₁ - x₂) := ⟨_, rfl⟩ + have hNNv : (x₁ - x₂) * nsv + = I.xnum x₂ * (x₁ - I.x₀) ^ 2 - I.xnum x₁ * (x₂ - I.x₀) ^ 2 := by + rw [hnsv]; field_simp + have hWv : (x₁ - x₂) * wsv + = (lam * (x₂ - I.x₀) + m') * I.ynum x₂ * (x₁ - I.x₀) ^ 3 + - (lam * (x₁ - I.x₀) + m') * I.ynum x₁ * (x₂ - I.x₀) ^ 3 := by + rw [hwsv]; field_simp + have hcert := chord_x_certificate ((x₁ - I.x₀) + (x₂ - I.x₀)) (x₁ - x₂) lam m' I.x₀ + nsv wsv hp_inst + (mul_left_cancel₀ (mul_ne_zero hdd h2p4) (by + have hN := hNNv + simp only [xnum, v, u] at hN + linear_combination ((2 : F)^8) * hN + hsem_ns)) + (mul_left_cancel₀ (mul_ne_zero hdd h2p6) (by + have hW := hWv + simp only [ynum, v, u] at hW + linear_combination ((2 : F)^12) * hW + hsem_ws)) + have hcorr := chord_final_correction ((x₁ - I.x₀) + (x₂ - I.x₀)) (x₁ - x₂) lam m' I.x₀ + I.domain.A I.domain.B + (by linear_combination 8 * hc₁ - 8 * (y₁ + lam * (x₁ - I.x₀) + m') * hL1) + (by linear_combination 8 * hc₂ - 8 * (y₂ + lam * (x₂ - I.x₀) + m') * hL2) + I.psi3 + -- defining equations of the image values, cleared of their denominators + have hX₁ : (I.mapXY x₁ y₁).1 * (x₁ - I.x₀) ^ 2 = I.s ^ 2 * I.xnum x₁ := by + simp only [mapXY] + exact div_mul_cancel₀ _ (pow_ne_zero 2 hd₁) + have hX₂ : (I.mapXY x₂ y₂).1 * (x₂ - I.x₀) ^ 2 = I.s ^ 2 * I.xnum x₂ := by + simp only [mapXY] + exact div_mul_cancel₀ _ (pow_ne_zero 2 hd₂) + have hX₃ : (I.mapXY x₃ y₃).1 * (x₃ - I.x₀) ^ 2 = I.s ^ 2 * I.xnum x₃ := by + simp only [mapXY] + exact div_mul_cancel₀ _ (pow_ne_zero 2 hd₃) + have hY₁ : (I.mapXY x₁ y₁).2 * (x₁ - I.x₀) ^ 3 + = I.s ^ 3 * ((lam * (x₁ - I.x₀) + m') * I.ynum x₁) := by + simp only [mapXY] + rw [← hL1] + exact div_mul_cancel₀ _ (pow_ne_zero 3 hd₁) + have hY₂ : (I.mapXY x₂ y₂).2 * (x₂ - I.x₀) ^ 3 + = I.s ^ 3 * ((lam * (x₂ - I.x₀) + m') * I.ynum x₂) := by + simp only [mapXY] + rw [← hL2] + exact div_mul_cancel₀ _ (pow_ne_zero 3 hd₂) + -- the difference and sum equations, in terms of the atoms + have hΔX : ((I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1) * ((x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2) + = I.s ^ 2 * ((x₁ - x₂) * nsv) := by + linear_combination (x₁ - I.x₀) ^ 2 * hX₂ - (x₂ - I.x₀) ^ 2 * hX₁ - I.s ^ 2 * hNNv + have hΔY : ((I.mapXY x₂ y₂).2 - (I.mapXY x₁ y₁).2) * ((x₁ - I.x₀) ^ 3 * (x₂ - I.x₀) ^ 3) + = I.s ^ 3 * ((x₁ - x₂) * wsv) := by + linear_combination (x₁ - I.x₀) ^ 3 * hY₂ - (x₂ - I.x₀) ^ 3 * hY₁ - I.s ^ 3 * hWv + have hsumX : ((I.mapXY x₃ y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₂ y₂).1) + * ((x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2) + = I.s ^ 2 * (I.xnum x₃ * (x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2 + + I.xnum x₁ * (x₂ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2 + + I.xnum x₂ * (x₁ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2) := by + linear_combination (x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2 * hX₃ + + (x₂ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2 * hX₁ + (x₁ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2 * hX₂ + -- the image abscissas are distinct + have hXne : (I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1 ≠ 0 := by + intro h0 + exact hne (I.abscissa_inj h2 hd h₁ h₂ (sub_eq_zero.mp h0).symm) + subst hx₃ + -- the cleared, slope-free key equation, closed by the certificate and correction + have hkeyc : (2 : F) ^ 10 + * ((((I.mapXY (lam ^ 2 - x₁ - x₂) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₂ y₂).1) + * ((x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2 * (lam ^ 2 - x₁ - x₂ - I.x₀) ^ 2)) + * (((I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1) * ((x₁ - I.x₀) ^ 2 * (x₂ - I.x₀) ^ 2)) ^ 2) + = (2 : F) ^ 10 + * ((((I.mapXY x₂ y₂).2 - (I.mapXY x₁ y₁).2) * ((x₁ - I.x₀) ^ 3 * (x₂ - I.x₀) ^ 3)) ^ 2 + * (lam ^ 2 - x₁ - x₂ - I.x₀) ^ 2) := by + have hN₁ : I.xnum x₁ = x₁ * (x₁ - I.x₀) ^ 2 + + 2 * (3 * I.x₀ ^ 2 + I.domain.A) * (x₁ - I.x₀) + + 4 * (I.x₀ ^ 3 + I.domain.A * I.x₀ + I.domain.B) := rfl + have hN₂ : I.xnum x₂ = x₂ * (x₂ - I.x₀) ^ 2 + + 2 * (3 * I.x₀ ^ 2 + I.domain.A) * (x₂ - I.x₀) + + 4 * (I.x₀ ^ 3 + I.domain.A * I.x₀ + I.domain.B) := rfl + have hN₃ : I.xnum (lam ^ 2 - x₁ - x₂) = (lam ^ 2 - x₁ - x₂) * (lam ^ 2 - x₁ - x₂ - I.x₀) ^ 2 + + 2 * (3 * I.x₀ ^ 2 + I.domain.A) * (lam ^ 2 - x₁ - x₂ - I.x₀) + + 4 * (I.x₀ ^ 3 + I.domain.A * I.x₀ + I.domain.B) := rfl + rw [hsumX, hΔX, hΔY, hN₁, hN₂, hN₃] + linear_combination I.s ^ 6 * hcert + I.s ^ 6 * (x₁ - x₂) * nsv ^ 2 * hcorr + have hkey : ((I.mapXY (lam ^ 2 - x₁ - x₂) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₂ y₂).1) + * ((I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1) ^ 2 + = ((I.mapXY x₂ y₂).2 - (I.mapXY x₁ y₁).2) ^ 2 := + mul_right_cancel₀ (mul_ne_zero (mul_ne_zero (pow_ne_zero 6 hd₁) (pow_ne_zero 6 hd₂)) + (pow_ne_zero 2 hd₃)) + (mul_left_cancel₀ (pow_ne_zero 10 h2) (by linear_combination hkeyc)) + have hdiv : (((I.mapXY x₂ y₂).2 - (I.mapXY x₁ y₁).2) + / ((I.mapXY x₂ y₂).1 - (I.mapXY x₁ y₁).1)) ^ 2 + = (I.mapXY (lam ^ 2 - x₁ - x₂) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₂ y₂).1 := by + rw [div_pow, ← hkey] + exact mul_div_cancel_right₀ _ (pow_ne_zero 2 hXne) + linear_combination -hdiv + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- Doubling compatibility at the coordinate level: the image of the doubled +point has exactly the abscissa the codomain doubling computes from the image +point. Parameters are pinned as in `chord_x_compat`; `hc` excludes rational +2-torsion on the codomain, which makes the image ordinate nonzero. -/ +theorem tangent_x_compat (h2 : (2 : F) ≠ 0) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + {x₁ y₁ lam x₃ y₃ : F} + (h₁ : OnCurve I.domain.A I.domain.B (x₁, y₁)) + (h₃ : OnCurve I.domain.A I.domain.B (x₃, y₃)) + (hy₁ : y₁ ≠ 0) + (hlam : lam = (3 * x₁ ^ 2 + I.domain.A) / (2 * y₁)) + (hx₃ : x₃ = lam ^ 2 - x₁ - x₁) + (hy₃ : y₃ = lam * (x₁ - x₃) - y₁) : + (I.mapXY x₃ y₃).1 = + ((3 * (I.mapXY x₁ y₁).1 ^ 2 + I.codomain.A) / (2 * (I.mapXY x₁ y₁).2)) ^ 2 + - (I.mapXY x₁ y₁).1 - (I.mapXY x₁ y₁).1 := by + have hd₁ : x₁ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₁) + have hd₃ : x₃ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₃) + have hc₁ : y₁ ^ 2 = x₁ ^ 3 + I.domain.A * x₁ + I.domain.B := h₁ + have h2y : (2 : F) * y₁ ≠ 0 := mul_ne_zero h2 hy₁ + have hslope : lam * (2 * y₁) = 3 * x₁ ^ 2 + I.domain.A := by + rw [hlam, div_mul_cancel₀ _ h2y] + set v' : F := y₁ - lam * (x₁ - I.x₀) with hv' + have hL : y₁ = lam * (x₁ - I.x₀) + v' := by linear_combination -hv' + have hbridgeT := tangent_psi3_bridge (x₁ - I.x₀) lam v' I.x₀ I.domain.A I.domain.B + (by linear_combination hc₁ - (y₁ + lam * (x₁ - I.x₀) + v') * hL) + (by linear_combination hslope - 2 * lam * hL) + I.psi3 + have hsem_k := tangent_k_semantics (x₁ - I.x₀) lam v' I.x₀ I.domain.A I.domain.B + (by linear_combination hc₁ - (y₁ + lam * (x₁ - I.x₀) + v') * hL) + (by linear_combination hslope - 2 * lam * hL) + have hsem_t := tangent_t_semantics (x₁ - I.x₀) lam v' I.x₀ I.domain.A I.domain.B + (by linear_combination hc₁ - (y₁ + lam * (x₁ - I.x₀) + v') * hL) + (by linear_combination hslope - 2 * lam * hL) + have hcorrT := tangent_correction (x₁ - I.x₀) lam v' I.x₀ I.domain.A I.domain.B + (by linear_combination hc₁ - (y₁ + lam * (x₁ - I.x₀) + v') * hL) + (by linear_combination hslope - 2 * lam * hL) + obtain ⟨kv, hkv⟩ : ∃ k : F, + k = 2 * (lam * (x₁ - I.x₀) + v') * I.ynum x₁ * (x₁ - I.x₀) := ⟨_, rfl⟩ + obtain ⟨tv, htv⟩ : ∃ t : F, + t = 3 * I.xnum x₁ ^ 2 + + (I.domain.A - 10 * (3 * I.x₀ ^ 2 + I.domain.A)) * (x₁ - I.x₀) ^ 4 := ⟨_, rfl⟩ + have hcertT := tangent_x_certificate (x₁ - I.x₀) lam v' I.x₀ kv tv + hbridgeT + (by + have hk := hkv + simp only [ynum, v, u] at hk + linear_combination hk + hsem_k) + (by + have ht := htv + simp only [xnum, v, u] at ht + linear_combination ht + hsem_t) + have hX₁ : (I.mapXY x₁ y₁).1 * (x₁ - I.x₀) ^ 2 = I.s ^ 2 * I.xnum x₁ := by + simp only [mapXY] + exact div_mul_cancel₀ _ (pow_ne_zero 2 hd₁) + have hX₃ : (I.mapXY x₃ y₃).1 * (x₃ - I.x₀) ^ 2 = I.s ^ 2 * I.xnum x₃ := by + simp only [mapXY] + exact div_mul_cancel₀ _ (pow_ne_zero 2 hd₃) + have hY₁ : (I.mapXY x₁ y₁).2 * (x₁ - I.x₀) ^ 3 + = I.s ^ 3 * ((lam * (x₁ - I.x₀) + v') * I.ynum x₁) := by + simp only [mapXY] + rw [← hL] + exact div_mul_cancel₀ _ (pow_ne_zero 3 hd₁) + have hY₁ne : (I.mapXY x₁ y₁).2 ≠ 0 := by + intro h0 + have himg := I.onCurve_mapXY h₁ + exact hc (I.mapXY x₁ y₁).1 (by rw [← h0, Prod.mk.eta]; exact himg) + have h2Y : ((2 : F) * (I.mapXY x₁ y₁).2) * (x₁ - I.x₀) ^ 4 = I.s ^ 3 * kv := by + linear_combination 2 * (x₁ - I.x₀) * hY₁ - I.s ^ 3 * hkv + have h3X : (3 * (I.mapXY x₁ y₁).1 ^ 2 + I.codomain.A) * (x₁ - I.x₀) ^ 4 + = I.s ^ 4 * tv := by + linear_combination + 3 * ((I.mapXY x₁ y₁).1 * (x₁ - I.x₀) ^ 2 + I.s ^ 2 * I.xnum x₁) * hX₁ + + (x₁ - I.x₀) ^ 4 * I.codomain_A - I.s ^ 4 * htv + have hsumXT : ((I.mapXY x₃ y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₁ y₁).1) + * ((x₁ - I.x₀) ^ 2 * (x₃ - I.x₀) ^ 2) + = I.s ^ 2 * (I.xnum x₃ * (x₁ - I.x₀) ^ 2 + 2 * I.xnum x₁ * (x₃ - I.x₀) ^ 2) := by + linear_combination (x₁ - I.x₀) ^ 2 * hX₃ + 2 * (x₃ - I.x₀) ^ 2 * hX₁ + subst hx₃ + have hkeycT : (2 : F) ^ 2 + * ((((I.mapXY (lam ^ 2 - x₁ - x₁) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₁ y₁).1) + * ((x₁ - I.x₀) ^ 2 * (lam ^ 2 - x₁ - x₁ - I.x₀) ^ 2)) + * (((2 : F) * (I.mapXY x₁ y₁).2) * (x₁ - I.x₀) ^ 4) ^ 2) + = (2 : F) ^ 2 + * (((3 * (I.mapXY x₁ y₁).1 ^ 2 + I.codomain.A) * (x₁ - I.x₀) ^ 4) ^ 2 + * ((x₁ - I.x₀) ^ 2 * (lam ^ 2 - x₁ - x₁ - I.x₀) ^ 2)) := by + have hN₁ : I.xnum x₁ = x₁ * (x₁ - I.x₀) ^ 2 + + 2 * (3 * I.x₀ ^ 2 + I.domain.A) * (x₁ - I.x₀) + + 4 * (I.x₀ ^ 3 + I.domain.A * I.x₀ + I.domain.B) := rfl + have hN₃ : I.xnum (lam ^ 2 - x₁ - x₁) = (lam ^ 2 - x₁ - x₁) * (lam ^ 2 - x₁ - x₁ - I.x₀) ^ 2 + + 2 * (3 * I.x₀ ^ 2 + I.domain.A) * (lam ^ 2 - x₁ - x₁ - I.x₀) + + 4 * (I.x₀ ^ 3 + I.domain.A * I.x₀ + I.domain.B) := rfl + rw [hsumXT, h2Y, h3X, hN₁, hN₃] + linear_combination I.s ^ 8 * hcertT + I.s ^ 8 * kv ^ 2 * hcorrT + have hkeyT : ((I.mapXY (lam ^ 2 - x₁ - x₁) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₁ y₁).1) + * ((2 : F) * (I.mapXY x₁ y₁).2) ^ 2 + = (3 * (I.mapXY x₁ y₁).1 ^ 2 + I.codomain.A) ^ 2 := + mul_right_cancel₀ (mul_ne_zero (pow_ne_zero 10 hd₁) (pow_ne_zero 2 hd₃)) + (mul_left_cancel₀ (pow_ne_zero 2 h2) (by linear_combination hkeycT)) + have hdivT : ((3 * (I.mapXY x₁ y₁).1 ^ 2 + I.codomain.A) + / (2 * (I.mapXY x₁ y₁).2)) ^ 2 + = (I.mapXY (lam ^ 2 - x₁ - x₁) y₃).1 + (I.mapXY x₁ y₁).1 + (I.mapXY x₁ y₁).1 := by + rw [div_pow, ← hkeyT] + have h2Yne : ((2 : F) * (I.mapXY x₁ y₁).2) ^ 2 ≠ 0 := + pow_ne_zero 2 (mul_ne_zero h2 hY₁ne) + exact mul_div_cancel_right₀ _ h2Yne + linear_combination -hdivT + +variable [DecidableEq F] + +set_option maxHeartbeats 1000000 in +/-- The isogeny respects addition at the abscissa level, for every pair of +points: each branch of `add` matches the corresponding branch on the images, +through `chord_x_compat` and `tangent_x_compat`. -/ +theorem map_add_x (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + (P Q : SWPoint I.domain) : + (I.map (P + Q)).x = (I.map P + I.map Q).x := by + by_cases hP0 : (P.x, P.y) = ((0 : F), (0 : F)) + · rw [SWPoint.ext_pair (E := I.domain) (Q := 0) hP0, _root_.zero_add, I.map_zero, + _root_.zero_add] + by_cases hQ0 : (Q.x, Q.y) = ((0 : F), (0 : F)) + · rw [SWPoint.ext_pair (E := I.domain) (Q := 0) hQ0, _root_.add_zero, I.map_zero, + _root_.add_zero] + have hP1 : OnCurve I.domain.A I.domain.B (P.x, P.y) := P.onCurve.resolve_right hP0 + have hQ1 : OnCurve I.domain.A I.domain.B (Q.x, Q.y) := Q.onCurve.resolve_right hQ0 + have himgP := I.onCurve_mapXY hP1 + have himgQ := I.onCurve_mapXY hQ1 + have himgP0 : ((I.mapXY P.x P.y).1, (I.mapXY P.x P.y).2) ≠ ((0 : F), (0 : F)) := by + intro hcon + exact origin_not_on_curve I.codomain (by rw [← Prod.mk.eta (p := I.mapXY P.x P.y), hcon] at himgP; exact himgP) + have himgQ0 : ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2) ≠ ((0 : F), (0 : F)) := by + intro hcon + exact origin_not_on_curve I.codomain (by rw [← Prod.mk.eta (p := I.mapXY Q.x Q.y), hcon] at himgQ; exact himgQ) + by_cases hxx : P.x = Q.x + · by_cases hyy : P.y + Q.y = 0 + · -- inverse pair: both sides are the identity + have hsum : P + Q = 0 := SWPoint.ext_pair (by + show add I.domain.A (P.x, P.y) (Q.x, Q.y) = (0, 0) + unfold add + rw [if_neg hP0, if_neg hQ0, if_pos hxx, if_pos hyy]) + rw [hsum, I.map_zero] + suffices h : I.map P + I.map Q = 0 by rw [h] + have hQy : Q.y = -P.y := by linear_combination hyy + have hQpair : I.mapXY Q.x Q.y = ((I.mapXY P.x P.y).1, -(I.mapXY P.x P.y).2) := by + rw [← hxx, hQy] + exact I.mapXY_neg P.x P.y + rw [map, dif_pos hP1, map, dif_pos hQ1] + apply SWPoint.ext_pair + show add I.codomain.A ((I.mapXY P.x P.y).1, (I.mapXY P.x P.y).2) + ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2) = (0, 0) + unfold add + rw [if_neg himgP0, if_neg himgQ0, + if_pos (show (I.mapXY P.x P.y).1 = (I.mapXY Q.x Q.y).1 by rw [hQpair]), + if_pos (show (I.mapXY P.x P.y).2 + (I.mapXY Q.x Q.y).2 = 0 by rw [hQpair]; ring)] + · -- doubling + have hyq : Q.y = P.y := by + have hsq : (P.y - Q.y) * (P.y + Q.y) = 0 := by + have e1 : P.y ^ 2 = P.x ^ 3 + I.domain.A * P.x + I.domain.B := hP1 + have e2 : Q.y ^ 2 = Q.x ^ 3 + I.domain.A * Q.x + I.domain.B := hQ1 + rw [hxx] at e1 + linear_combination e1 - e2 + rcases mul_eq_zero.mp hsq with h | h + · linear_combination -h + · exact absurd h hyy + have hy1 : P.y ≠ 0 := by + intro h0 + exact hyy (by rw [hyq, h0]; ring) + have hQP : Q = P := SWPoint.ext_pair (Prod.ext_iff.mpr ⟨hxx.symm, hyq⟩) + subst hQP + -- the domain doubling output + have hpair : add I.domain.A (Q.x, Q.y) (Q.x, Q.y) + = (((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) ^ 2 - Q.x - Q.x, + ((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) + * (Q.x - (((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) ^ 2 - Q.x - Q.x)) - Q.y) := by + unfold add + rw [if_neg hQ0, if_neg hQ0, if_pos rfl, if_neg hyy] + have hxagree : (Q + Q).x = ((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) ^ 2 - Q.x - Q.x := by + show (add I.domain.A (Q.x, Q.y) (Q.x, Q.y)).1 = _ + rw [hpair] + have hyagree : (Q + Q).y = ((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) + * (Q.x - (((3 * Q.x ^ 2 + I.domain.A) / (2 * Q.y)) ^ 2 - Q.x - Q.x)) - Q.y := by + show (add I.domain.A (Q.x, Q.y) (Q.x, Q.y)).2 = _ + rw [hpair] + have h₃ : OnCurve I.domain.A I.domain.B ((Q + Q).x, (Q + Q).y) := by + refine (Q + Q).onCurve.resolve_right ?_ + intro h0 + have h2Q : Q + Q = 0 := SWPoint.ext_pair h0 + have hQn : Q = -Q := add_eq_zero_iff_eq_neg.mp h2Q + have hyneg : Q.y = -Q.y := by + have h := congrArg SWPoint.y hQn + rwa [SWPoint.neg_y] at h + exact hy1 (by + have h2y : (2 : F) * Q.y = 0 := by linear_combination hyneg + exact (mul_eq_zero.mp h2y).resolve_left h2) + -- the image side: doubling of the image point + have hY1ne : (I.mapXY Q.x Q.y).2 ≠ 0 := by + intro h0 + exact hc (I.mapXY Q.x Q.y).1 (by rw [← h0, Prod.mk.eta]; exact himgQ) + rw [map, dif_pos h₃, map, dif_pos hQ1] + show (I.mapXY (Q + Q).x (Q + Q).y).1 + = (add I.codomain.A ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2) + ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2)).1 + have haddimg : (add I.codomain.A ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2) + ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2)).1 + = ((3 * (I.mapXY Q.x Q.y).1 ^ 2 + I.codomain.A) / (2 * (I.mapXY Q.x Q.y).2)) ^ 2 + - (I.mapXY Q.x Q.y).1 - (I.mapXY Q.x Q.y).1 := by + unfold add + rw [if_neg himgQ0, if_neg himgQ0, if_pos rfl, + if_neg (fun hcon => hY1ne ((mul_eq_zero.mp (by linear_combination hcon)).resolve_left h2))] + rw [haddimg] + exact I.tangent_x_compat h2 hc hQ1 h₃ hy1 rfl hxagree (by rw [hyagree, hxagree]) + · -- chord + have hXne : (I.mapXY P.x P.y).1 ≠ (I.mapXY Q.x Q.y).1 := by + intro hcon + exact hxx (I.abscissa_inj h2 hd hP1 hQ1 hcon) + have hpair : add I.domain.A (P.x, P.y) (Q.x, Q.y) + = (((Q.y - P.y) / (Q.x - P.x)) ^ 2 - P.x - Q.x, + ((Q.y - P.y) / (Q.x - P.x)) + * (P.x - (((Q.y - P.y) / (Q.x - P.x)) ^ 2 - P.x - Q.x)) - P.y) := by + unfold add + rw [if_neg hP0, if_neg hQ0, if_neg hxx] + have hxagree : (P + Q).x = ((Q.y - P.y) / (Q.x - P.x)) ^ 2 - P.x - Q.x := by + show (add I.domain.A (P.x, P.y) (Q.x, Q.y)).1 = _ + rw [hpair] + have hyagree : (P + Q).y = ((Q.y - P.y) / (Q.x - P.x)) + * (P.x - (((Q.y - P.y) / (Q.x - P.x)) ^ 2 - P.x - Q.x)) - P.y := by + show (add I.domain.A (P.x, P.y) (Q.x, Q.y)).2 = _ + rw [hpair] + have h₃ : OnCurve I.domain.A I.domain.B ((P + Q).x, (P + Q).y) := by + refine (P + Q).onCurve.resolve_right ?_ + intro h0 + have hPQ : P + Q = 0 := SWPoint.ext_pair h0 + have hQn : Q = -P := by + have := add_eq_zero_iff_neg_eq.mp hPQ + exact this.symm + exact hxx (by rw [hQn]; exact (SWPoint.neg_x P).symm) + rw [map, dif_pos h₃, map, dif_pos hP1, map, dif_pos hQ1] + show (I.mapXY (P + Q).x (P + Q).y).1 + = (add I.codomain.A ((I.mapXY P.x P.y).1, (I.mapXY P.x P.y).2) + ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2)).1 + have haddimg : (add I.codomain.A ((I.mapXY P.x P.y).1, (I.mapXY P.x P.y).2) + ((I.mapXY Q.x Q.y).1, (I.mapXY Q.x Q.y).2)).1 + = (((I.mapXY Q.x Q.y).2 - (I.mapXY P.x P.y).2) + / ((I.mapXY Q.x Q.y).1 - (I.mapXY P.x P.y).1)) ^ 2 + - (I.mapXY P.x P.y).1 - (I.mapXY Q.x Q.y).1 := by + unfold add + rw [if_neg himgP0, if_neg himgQ0, if_neg hXne] + rw [haddimg] + exact I.chord_x_compat h2 hd hP1 hQ1 h₃ hxx rfl hxagree (by rw [hyagree, hxagree]) + +/-- The isogeny commutes with negation on points. -/ +theorem map_neg (P : SWPoint I.domain) : I.map (-P) = -I.map P := by + by_cases hP : OnCurve I.domain.A I.domain.B (P.x, P.y) + · have hnP : OnCurve I.domain.A I.domain.B ((-P).x, (-P).y) := by + have h : P.y ^ 2 = P.x ^ 3 + I.domain.A * P.x + I.domain.B := hP + show (-P.y) ^ 2 = P.x ^ 3 + I.domain.A * P.x + I.domain.B + linear_combination h + apply SWPoint.ext_pair + rw [map, dif_pos hnP, map, dif_pos hP] + show ((I.mapXY P.x (-P.y)).1, (I.mapXY P.x (-P.y)).2) + = ((I.mapXY P.x P.y).1, -(I.mapXY P.x P.y).2) + rw [Prod.mk.eta, I.mapXY_neg] + · have hP0 : (P.x, P.y) = ((0 : F), (0 : F)) := P.onCurve.resolve_left hP + rw [SWPoint.ext_pair (E := I.domain) (Q := 0) hP0, neg_zero, I.map_zero, neg_zero] + +omit [DecidableEq F] in +/-- Two on-curve points with the same abscissa are equal or negatives. -/ +private theorem eq_or_eq_neg_of_x_eq {E : SWCurve F} {R S : SWPoint E} + (hR : OnCurve E.A E.B (R.x, R.y)) (hS : OnCurve E.A E.B (S.x, S.y)) + (hx : R.x = S.x) : R = S ∨ R = -S := by + have h1 : R.y ^ 2 = R.x ^ 3 + E.A * R.x + E.B := hR + have h2 : S.y ^ 2 = S.x ^ 3 + E.A * S.x + E.B := hS + rw [hx] at h1 + have h0 : (R.y - S.y) * (R.y + S.y) = 0 := by linear_combination h1 - h2 + rcases mul_eq_zero.mp h0 with h | h + · exact Or.inl (SWPoint.ext_pair (Prod.ext_iff.mpr ⟨hx, sub_eq_zero.mp h⟩)) + · exact Or.inr (SWPoint.ext_pair (Prod.ext_iff.mpr + ⟨by rw [SWPoint.neg_x]; exact hx, by rw [SWPoint.neg_y]; linear_combination h⟩)) + +/-- The image of a sum is the sum of the images, up to sign. -/ +theorem map_add_pm (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + (P Q : SWPoint I.domain) : + I.map (P + Q) = I.map P + I.map Q ∨ I.map (P + Q) = -(I.map P + I.map Q) := by + by_cases hs : OnCurve I.domain.A I.domain.B ((P + Q).x, (P + Q).y) + · by_cases hi : OnCurve I.codomain.A I.codomain.B + ((I.map P + I.map Q).x, (I.map P + I.map Q).y) + · have hLon : OnCurve I.codomain.A I.codomain.B + ((I.map (P + Q)).x, (I.map (P + Q)).y) := by + rw [map, dif_pos hs] + exact I.onCurve_mapXY hs + exact eq_or_eq_neg_of_x_eq hLon hi (I.map_add_x h2 hd hc P Q) + · exfalso + have hi0 : ((I.map P + I.map Q).x, (I.map P + I.map Q).y) = ((0 : F), (0 : F)) := + (I.map P + I.map Q).onCurve.resolve_left hi + have hsum0 : I.map P + I.map Q = 0 := SWPoint.ext_pair hi0 + have hQn : I.map Q = I.map (-P) := by + rw [I.map_neg] + exact (add_eq_zero_iff_neg_eq.mp hsum0).symm + have hQP : Q = -P := I.map_injective h2 hc hQn + have hPQ0 : P + Q = 0 := by rw [hQP]; exact add_neg_cancel P + rw [hPQ0] at hs + exact origin_not_on_curve I.domain hs + · have hs0 : ((P + Q).x, (P + Q).y) = ((0 : F), (0 : F)) := + (P + Q).onCurve.resolve_left hs + have hPQ : P + Q = 0 := SWPoint.ext_pair hs0 + have hQ : Q = -P := (add_eq_zero_iff_neg_eq.mp hPQ).symm + left + rw [hPQ, I.map_zero, hQ, I.map_neg] + exact (add_neg_cancel _).symm + +/-- The homomorphism property: the isogeny respects addition on rational points. -/ +theorem map_add (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + (P Q : SWPoint I.domain) : + I.map (P + Q) = I.map P + I.map Q := by + rcases I.map_add_pm h2 hd hc P Q with h | h + · exact h + · rcases I.map_add_pm h2 hd hc (P + Q) (-Q) with h' | h' + · rw [add_neg_cancel_right, I.map_neg, h] at h' + have hstep : I.map P + (I.map P + I.map Q + I.map Q) = 0 := by + nth_rewrite 1 [h'] + abel + have h20 : (I.map P + I.map Q) + (I.map P + I.map Q) = 0 := by + calc (I.map P + I.map Q) + (I.map P + I.map Q) + = I.map P + (I.map P + I.map Q + I.map Q) := by abel + _ = 0 := hstep + have hz := eq_zero_of_two_nsmul_eq_zero h2 hc (by rw [two_nsmul]; exact h20) + rw [h, hz, neg_zero] + · rw [add_neg_cancel_right, I.map_neg, h] at h' + have hh : I.map P = I.map P + I.map Q + I.map Q := by + calc I.map P = -(-(I.map P + I.map Q) + -I.map Q) := h' + _ = I.map P + I.map Q + I.map Q := by abel + have h2Q : I.map Q + I.map Q = 0 := by + calc I.map Q + I.map Q = -I.map P + (I.map P + I.map Q + I.map Q) := by abel + _ = -I.map P + I.map P := by rw [← hh] + _ = 0 := by abel + have hQ0 : I.map Q = 0 := + eq_zero_of_two_nsmul_eq_zero h2 hc (by rw [two_nsmul]; exact h2Q) + have hQz : Q = 0 := I.map_injective h2 hc (by rw [hQ0, I.map_zero]) + rw [hQz, _root_.add_zero, I.map_zero, _root_.add_zero] + +/-! ## The deployed hash-to-curve construction -/ + +/-- The deployed hash-to-curve construction after `hash_to_field`, which stays +abstract here — RFC 9380's `hash_to_curve` includes it, hence the distinct +name. The RFC intentionally does not provide this composition as a named +operation: it is cryptographically hazardous unless composed with +`hash_to_field`, and naming it could mislead people into thinking it can be +modelled as a random oracle by itself. Maps two field elements, intended to +be outputs of `hash_to_field`, to the isogeny's domain curve, adds there, and +applies the isogeny once (spec §5.4.9.8). -/ +def mapHashOutputsToCurve (m : F → SWPoint I.domain) (u₀ u₁ : F) : SWPoint I.codomain := + I.map (m u₀ + m u₁) + +/-- `mapHashOutputsToCurve` agrees with applying the isogeny to each point and +adding on the codomain. RFC 9380 §6.6.3 notes exactly this optimization —add on +the isogenous curve, so the isogeny map is evaluated once— "relying on iso_map +being a group homomorphism"; `map_add` is that fact for the deployed maps. The +spec and `hashtocurve.sage` use the one-evaluation order, while +`zcash-test-vectors` and `pasta_curves` map each point and add on the codomain. -/ +theorem mapHashOutputsToCurve_eq (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + (m : F → SWPoint I.domain) (u₀ u₁ : F) : + I.mapHashOutputsToCurve m u₀ u₁ = I.map (m u₀) + I.map (m u₁) := + I.map_add h2 hd hc (m u₀) (m u₁) + +end CompElliptic.Isogenies.ThreeIsogeny diff --git a/CompElliptic/Isogenies/ThreeIsogeny.lean b/CompElliptic/Isogenies/ThreeIsogeny.lean new file mode 100644 index 0000000..6ff6c1e --- /dev/null +++ b/CompElliptic/Isogenies/ThreeIsogeny.lean @@ -0,0 +1,371 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import CompElliptic.CurveForms.ShortWeierstrass +import Mathlib.Tactic.LinearCombination +import Mathlib.Tactic.FieldSimp + +/-! +# Degree-3 isogenies from Vélu's formulae + +An *isogeny* is a nonconstant rational map between elliptic curves that sends the +identity to the identity; it is automatically a group homomorphism. A degree-3 isogeny +sends three points of the domain (counted over the algebraic closure) to each point of +the codomain, and its *kernel* — the three points sent to the identity — determines it +up to isomorphism. + +The reason this library needs one: the simplified SWU mapping requires a curve +coefficient `A ≠ 0`, and both Pasta curves have `A = 0`. RFC 9380 handles such targets +by mapping to an auxiliary curve that is 3-isogenous to the target and then carrying +the result across the isogeny. + +This module formalizes the method behind the specified maps, not only their +coefficients. The maps in the protocol specification are the `rational_maps()` of +the isogenies that `zcash/pasta`'s `amicable.sage` found with Sage's +`isogenies_prime_degree(3)`; Sage builds such maps by Vélu's formulae from the +kernel, composed with the isomorphism `(x, y) ↦ (s²·x, s³·y)` that normalizes the +codomain. `ThreeIsogeny` takes exactly that input —the kernel abscissa `x₀` and the +normalizing scalar `s`— and derives the rational maps and the codomain coefficients +from them. A concrete instance then only has to check that its specified coefficients +match what the derivation yields, which is a handful of numeral equations rather than +a curve-sized polynomial identity. + +A kernel of size 3 is `{𝒪, T, -T}` for a point `T = (x₀, ±y₀)` of order 3, and `x₀` +being a root of the degree-3 division polynomial `ψ₃` says exactly that. The two +kernel points share the abscissa, so Vélu's sums over the kernel collapse to +polynomials in `x₀` and `y₀² = x₀³ + A·x₀ + B`; everything stays rational in `x₀` even +when `y₀` itself lies in a quadratic extension. For the instances used here `y₀²` is a +nonsquare, so the kernel points have no rational ordinate at all. That hypothesis +(`kernel_irrational`) is what makes the affine rational map total on rational points: +its denominators vanish only on the kernel fibre `x = x₀`, and no rational point of +the domain lies there (`ne_x₀`). + +The maps take an affine point `(x, y)` of the domain to +`(s² · xnum x / (x - x₀)², s³ · y · ynum x / (x - x₀)³)`, and `onCurve_mapXY` proves +the result lands on the codomain. The ordinate is `y` times a function of `x` alone, +so negating the input negates the output (`mapXY_neg`): the isogeny commutes with +negation, which the hash-to-curve analysis consumes as oddness. + +`map` packages the affine map as a function on curve points, sending the identity to +the identity. It is injective on rational points (`map_injective`): an abscissa +collision would exhibit the nonsquare `y₀²` as a square (`abscissa_inj`), and rational +2-torsion —excluded on the codomain by hypothesis, and transported to the domain by +`no_y_zero_of_codomain`— is the only degenerate case. No homomorphism property is +consumed. When the domain and codomain have equal finite order, counting upgrades +injectivity to a bijection on rational points (`map_bijective`). + +## References + +- J. Vélu, "Isogénies entre courbes elliptiques", Comptes Rendus de l'Académie des + Sciences de Paris, Série A, 273 (1971), A238–A241. (The formulae giving a separable + isogeny with prescribed kernel, and its codomain.) +- J. H. Silverman, "The Arithmetic of Elliptic Curves", 2nd edition, Graduate Texts + in Mathematics 106, Springer, 2009. (Theorem III.4.8: an isogeny is a group + homomorphism.) +- S. D. Galbraith, "Mathematics of Public Key Cryptography", Cambridge University + Press, 2012. Extended Chapter 25, "Isogenies of elliptic curves": + . Theorem 25.1.6 + states Vélu's formulae in the Weierstrass form used here (section 25.1.1), and + section 25.1 notes that an isogeny is automatically a group homomorphism. +-/ + +open CompElliptic.CurveForms.ShortWeierstrass + +namespace CompElliptic.Isogenies + +variable {F : Type*} [Field F] + +/-- A degree-3 isogeny in the normalized form produced by Sage's `rational_maps()`: +Vélu's formulae for the kernel `{𝒪, (x₀, ±y₀)}`, composed with the curve isomorphism +`(x, y) ↦ (s²·x, s³·y)`. The `psi3` field says `x₀` is a root of the degree-3 division +polynomial of the domain, so the fibre over `x₀` together with `𝒪` is a subgroup of +order 3 over the algebraic closure; `kernel_irrational` says the two kernel points are +not rational. The codomain is pinned by the two coefficient equations that Vélu's +formulae dictate. -/ +structure ThreeIsogeny (F : Type*) [Field F] where + /-- The domain curve (the auxiliary "iso-curve" in the hash-to-curve application). -/ + domain : SWCurve F + /-- The codomain curve (the target of the hash-to-curve application). -/ + codomain : SWCurve F + /-- The shared abscissa of the two affine kernel points. -/ + x₀ : F + /-- The scaling of the isomorphism composed after Vélu's isogeny. -/ + s : F + s_nonzero : s ≠ 0 + /-- `x₀` is a root of the domain's degree-3 division polynomial + `ψ₃(X) = 3·X⁴ + 6·A·X² + 12·B·X - A²`. -/ + psi3 : 3 * x₀^4 + 6 * domain.A * x₀^2 + 12 * domain.B * x₀ - domain.A^2 = 0 + /-- The square of the kernel ordinate, `y₀² = x₀³ + A·x₀ + B`, is a nonsquare: the + kernel points exist only over a quadratic extension. -/ + kernel_irrational : ¬ IsSquare (x₀^3 + domain.A * x₀ + domain.B) + /-- The codomain's `A`, as Vélu's formulae and the scaling dictate. -/ + codomain_A : codomain.A = s^4 * (domain.A - 10 * (3 * x₀^2 + domain.A)) + /-- The codomain's `B`, as Vélu's formulae and the scaling dictate. -/ + codomain_B : codomain.B = + s^6 * (domain.B - 7 * (4 * (x₀^3 + domain.A * x₀ + domain.B) + + 2 * (3 * x₀^2 + domain.A) * x₀)) + +namespace ThreeIsogeny + +variable (I : ThreeIsogeny F) + +/-- Vélu's linear coefficient, summed over the two kernel points: `v = 2·(3·x₀² + A)`. -/ +def v : F := 2 * (3 * I.x₀^2 + I.domain.A) + +/-- Vélu's constant coefficient, summed over the two kernel points: `u = 4·y₀²`. -/ +def u : F := 4 * (I.x₀^3 + I.domain.A * I.x₀ + I.domain.B) + +/-- The numerator of the abscissa map over the denominator `(x - x₀)²`. -/ +def xnum (x : F) : F := x * (x - I.x₀)^2 + I.v * (x - I.x₀) + I.u + +/-- The `x`-dependent factor of the ordinate map's numerator, over the denominator +`(x - x₀)³`. The full ordinate map is `y` times this ratio, which is exactly the +derivative of the abscissa map — Vélu's isogeny is normalized, so it pulls the +invariant differential back to itself. -/ +def ynum (x : F) : F := (x - I.x₀)^3 - I.v * (x - I.x₀) - 2 * I.u + +/-- The affine rational map: Vélu's isogeny followed by the normalizing isomorphism. -/ +def mapXY (x y : F) : F × F := + (I.s^2 * I.xnum x / (x - I.x₀)^2, I.s^3 * (y * I.ynum x) / (x - I.x₀)^3) + +/-- No rational point of the domain has the kernel abscissa: its ordinate would be a +rational square root of the nonsquare `y₀²`. Hence the denominators of `mapXY` do not +vanish on rational points. -/ +theorem ne_x₀ {x y : F} (h : OnCurve I.domain.A I.domain.B (x, y)) : x ≠ I.x₀ := by + intro hx + subst hx + refine I.kernel_irrational ⟨y, ?_⟩ + have h' : y^2 = I.x₀^3 + I.domain.A * I.x₀ + I.domain.B := h + linear_combination -h' + +/- The cleared on-curve identity behind `onCurve_mapXY` was checked, and its +`linear_combination` cofactor computed, with this Sage script: + +``` + R. = PolynomialRing(QQ, order='lex') + g = x^3 + a*x + b + psi3 = 3*x0^4 + 6*a*x0^2 + 12*b*x0 - a^2 + v = 2*(3*x0^2 + a) + u = 4*(x0^3 + a*x0 + b) + D = x - x0 + xnum = x*D^2 + v*D + u + ynum = D^3 - v*D - 2*u + A1 = a - 5*v + B1 = b - 7*(u + v*x0) + diff = g*ynum^2 - (xnum^3 + A1*xnum*D^4 + B1*D^6) + q, r = diff.quo_rem(psi3) + assert r == 0 + print(q) +``` + +The remainder is zero — the identity holds modulo `ψ₃` alone — and `q` is the +cofactor used below. -/ + +/-- The on-curve identity with denominators cleared: multiplying the codomain equation +at `mapXY x y` through by `(x - x₀)⁶` leaves a polynomial identity that follows from +the curve equation and `ψ₃(x₀) = 0`. -/ +theorem key_identity {x y : F} (h : OnCurve I.domain.A I.domain.B (x, y)) : + I.s^6 * (y * I.ynum x)^2 = + (I.s^2 * I.xnum x)^3 + I.codomain.A * (I.s^2 * I.xnum x) * (x - I.x₀)^4 + + I.codomain.B * (x - I.x₀)^6 := by + have hy : y^2 = x^3 + I.domain.A * x + I.domain.B := h + rw [I.codomain_A, I.codomain_B] + simp only [xnum, ynum, v, u] + linear_combination (I.s^6 * ((x - I.x₀)^3 - (2 * (3 * I.x₀^2 + I.domain.A)) * (x - I.x₀) + - 2 * (4 * (I.x₀^3 + I.domain.A * I.x₀ + I.domain.B)))^2) * hy + + (I.s^6 * (-6 * x^5 + 30 * x^4 * I.x₀ - 48 * x^3 * I.x₀^2 + 4 * x^3 * I.domain.A + + 36 * x^2 * I.x₀^3 + 12 * x^2 * I.domain.B - 18 * x * I.x₀^4 + - 12 * x * I.x₀^2 * I.domain.A - 24 * x * I.x₀ * I.domain.B + 6 * I.x₀^5 + + 8 * I.x₀^3 * I.domain.A + 12 * I.x₀^2 * I.domain.B)) * I.psi3 + +/-- Every rational point of the domain maps onto the codomain. -/ +theorem onCurve_mapXY {x y : F} (h : OnCurve I.domain.A I.domain.B (x, y)) : + OnCurve I.codomain.A I.codomain.B (I.mapXY x y) := by + have hD : x - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h) + have key := I.key_identity h + show (I.s^3 * (y * I.ynum x) / (x - I.x₀)^3)^2 = + (I.s^2 * I.xnum x / (x - I.x₀)^2)^3 + + I.codomain.A * (I.s^2 * I.xnum x / (x - I.x₀)^2) + I.codomain.B + field_simp [hD] + linear_combination key + +/-- The isogeny commutes with negation: the ordinate map is `y` times a function of +the abscissa alone. -/ +theorem mapXY_neg (x y : F) : + I.mapXY x (-y) = ((I.mapXY x y).1, -(I.mapXY x y).2) := by + simp only [mapXY, Prod.mk.injEq] + exact ⟨trivial, by ring⟩ + +/-- Freedom from rational 2-torsion transports backwards along the isogeny: a rational +point of the domain with `y = 0` would map to a point of the codomain with `y = 0`, +because the image ordinate carries the factor `y`. -/ +theorem no_y_zero_of_codomain + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) (x : F) : + ¬ OnCurve I.domain.A I.domain.B (x, 0) := by + intro h + have himg := I.onCurve_mapXY h + have hy : (I.mapXY x 0).2 = 0 := by simp [mapXY] + exact hc (I.mapXY x 0).1 (hy ▸ himg) + + +/- The collision identity behind `abscissa_inj` was derived, and its cofactors computed, +with this Sage script: + +``` + R. = PolynomialRing(QQ) + g0 = x0^3 + a*x0 + b + psi3 = 3*x0^4 + 6*a*x0^2 + 12*b*x0 - a^2 + v = 2*(3*x0^2 + a) + uc = 4*g0 + xnum = lambda t: t*(t - x0)^2 + v*(t - x0) + uc + H = xnum(u)*(w - x0)^2 - xnum(w)*(u - x0)^2 + G = H // (u - w) # exact: (u - w) divides H + A2 = R(G.coefficient({w: 2})) # = (u - x0)^2 + A1 = R(G.coefficient({w: 1})) + disc = A1^2 - 4*A2*R(G.coefficient({w: 0})) + E = disc - 16*g0*y1^2 + c1 = R(-16*g0) + c3 = (E - c1*(y1^2 - (u^3 + a*u + b))) // psi3 # exact division + assert (2*A2*w + A1)^2 - 16*g0*y1^2 - 4*A2*G - c1*(y1^2 - (u^3+a*u+b)) - c3*psi3 == 0 +``` + +`G = 0` is the condition for the two abscissas to collide. It is quadratic in `w`, with +leading coefficient `A2 = (u - x₀)²`, and its roots are the abscissas of the translates +`P ± T`. Its discriminant (the squared difference of its roots, scaled by `A2²`) is +therefore forced to be `(x(P+T) - x(P-T))²·A2² = 16·y₀²·y₁²`, modulo the curve equation +and `ψ₃`. Completing the square and multiplying through by `u - w` gives the identity +`abscissa_inj` consumes, with `c3 = -4·(u - x₀)²`. -/ + +/-- Distinct rational abscissas have distinct image abscissas. A collision would make +the second abscissa a rational root of a quadratic whose discriminant is +`(x(P+T) - x(P-T))²`, the squared difference of the abscissas of the two kernel +translates. That discriminant is `16·y₀²·y₁²` up to the square `(x₁ - x₀)⁴`, so a +rational root exhibits the nonsquare `y₀²` as a square, contradicting +`kernel_irrational`. The degenerate case `y₁ = 0` is rational 2-torsion, which `hd` +excludes. -/ +theorem abscissa_inj (h2 : (2 : F) ≠ 0) + (hd : ∀ X : F, ¬ OnCurve I.domain.A I.domain.B (X, 0)) + {x₁ y₁ x₂ y₂ : F} (h₁ : OnCurve I.domain.A I.domain.B (x₁, y₁)) + (h₂ : OnCurve I.domain.A I.domain.B (x₂, y₂)) + (hX : (I.mapXY x₁ y₁).1 = (I.mapXY x₂ y₂).1) : x₁ = x₂ := by + by_contra hne + have hy1 : y₁ ≠ 0 := fun h0 => hd x₁ (h0 ▸ h₁) + have hcurve : y₁^2 = x₁^3 + I.domain.A * x₁ + I.domain.B := h₁ + have hD₁ : x₁ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₁) + have hD₂ : x₂ - I.x₀ ≠ 0 := sub_ne_zero.mpr (I.ne_x₀ h₂) + have hH : I.xnum x₁ * (x₂ - I.x₀)^2 = I.xnum x₂ * (x₁ - I.x₀)^2 := by + have hX' := hX + simp only [mapXY] at hX' + rw [div_eq_div_iff (pow_ne_zero 2 hD₁) (pow_ne_zero 2 hD₂)] at hX' + apply mul_left_cancel₀ (pow_ne_zero 2 I.s_nonzero) + linear_combination hX' + simp only [xnum, v, u] at hH + have key : (x₁ - x₂) * + ((2 * (x₁ - I.x₀)^2 * x₂ + (-2 * x₁^2 * I.x₀ - 2 * x₁ * I.x₀^2 + - 2 * x₁ * I.domain.A - 2 * I.x₀ * I.domain.A - 4 * I.domain.B))^2 + - 16 * (I.x₀^3 + I.domain.A * I.x₀ + I.domain.B) * y₁^2) = 0 := by + linear_combination (4 * (x₁ - I.x₀)^2) * hH + + ((x₁ - x₂) * (-16 * (I.x₀^3 + I.domain.A * I.x₀ + I.domain.B))) * hcurve + + ((x₁ - x₂) * (-4 * (x₁ - I.x₀)^2)) * I.psi3 + rcases mul_eq_zero.mp key with h | h + · exact hne (sub_eq_zero.mp h) + · have h4 : (4 : F) ≠ 0 := by + have h : (4 : F) = 2 * 2 := by norm_num + rw [h]; exact mul_ne_zero h2 h2 + refine I.kernel_irrational ⟨(2 * (x₁ - I.x₀)^2 * x₂ + (-2 * x₁^2 * I.x₀ + - 2 * x₁ * I.x₀^2 - 2 * x₁ * I.domain.A - 2 * I.x₀ * I.domain.A + - 4 * I.domain.B)) / (4 * y₁), ?_⟩ + rw [div_mul_div_comm, eq_div_iff (mul_ne_zero (mul_ne_zero h4 hy1) (mul_ne_zero h4 hy1))] + linear_combination -h + +variable [DecidableEq F] + +/-- The isogeny on curve points: an affine point maps through `mapXY` (its image is +affine, because `(0, 0)` is not on the codomain), and the identity maps to the +identity. -/ +def map (P : SWPoint I.domain) : SWPoint I.codomain := + if h : OnCurve I.domain.A I.domain.B (P.x, P.y) then + ⟨(I.mapXY P.x P.y).1, (I.mapXY P.x P.y).2, Or.inl (I.onCurve_mapXY h)⟩ + else 0 + +/-- The identity maps to the identity: its sentinel pair `(0, 0)` is not on the domain +curve, so `map` takes its else branch. -/ +@[simp] theorem map_zero : I.map 0 = 0 := by + rw [map] + exact dif_neg (origin_not_on_curve I.domain) + +/-- The isogeny is injective on rational points: image abscissas agree only on equal +abscissas (`abscissa_inj`). Over one abscissa the two ordinates are negatives, so equal +images with unequal ordinates would make the image 2-torsion, which `hc` excludes on +the codomain. No homomorphism property is consumed. -/ +theorem map_injective (h2 : (2 : F) ≠ 0) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) : + Function.Injective I.map := by + have hd := I.no_y_zero_of_codomain hc + intro P Q hPQ + by_cases hP : OnCurve I.domain.A I.domain.B (P.x, P.y) <;> + by_cases hQ : OnCurve I.domain.A I.domain.B (Q.x, Q.y) + · rw [map, dif_pos hP, map, dif_pos hQ] at hPQ + have hx : (I.mapXY P.x P.y).1 = (I.mapXY Q.x Q.y).1 := congrArg SWPoint.x hPQ + have hy : (I.mapXY P.x P.y).2 = (I.mapXY Q.x Q.y).2 := congrArg SWPoint.y hPQ + have hxx : P.x = Q.x := I.abscissa_inj h2 hd hP hQ hx + have hyy : P.y = Q.y ∨ P.y = -Q.y := by + have h1 : P.y^2 = Q.y^2 := by + have e1 : P.y^2 = P.x^3 + I.domain.A * P.x + I.domain.B := hP + have e2 : Q.y^2 = Q.x^3 + I.domain.A * Q.x + I.domain.B := hQ + rw [e1, e2, hxx] + have h0 : (P.y - Q.y) * (P.y + Q.y) = 0 := by linear_combination h1 + rcases mul_eq_zero.mp h0 with h | h + · exact Or.inl (sub_eq_zero.mp h) + · exact Or.inr (by linear_combination h) + rcases hyy with h | h + · exact SWPoint.ext_pair (by rw [hxx, h]) + · by_cases heq : P.y = Q.y + · exact SWPoint.ext_pair (by rw [hxx, heq]) + · exfalso + have hzero : (I.mapXY Q.x Q.y).2 = 0 := by + have hflip : -(I.mapXY Q.x Q.y).2 = (I.mapXY Q.x Q.y).2 := by + calc -(I.mapXY Q.x Q.y).2 = (I.mapXY Q.x (-Q.y)).2 := by rw [I.mapXY_neg] + _ = (I.mapXY P.x P.y).2 := by rw [← hxx, ← h] + _ = (I.mapXY Q.x Q.y).2 := hy + have h2x : (2 : F) * (I.mapXY Q.x Q.y).2 = 0 := by linear_combination -hflip + exact (mul_eq_zero.mp h2x).resolve_left h2 + have himg := I.onCurve_mapXY hQ + exact hc (I.mapXY Q.x Q.y).1 (hzero ▸ himg) + · exfalso + rw [map, dif_pos hP, map, dif_neg hQ] at hPQ + have hx0 : (I.mapXY P.x P.y).1 = (0 : F) := congrArg SWPoint.x hPQ + have hy0 : (I.mapXY P.x P.y).2 = (0 : F) := congrArg SWPoint.y hPQ + have himg := I.onCurve_mapXY hP + have hpair : I.mapXY P.x P.y = ((0 : F), (0 : F)) := Prod.ext_iff.mpr ⟨hx0, hy0⟩ + rw [hpair] at himg + exact origin_not_on_curve I.codomain himg + · exfalso + rw [map, dif_neg hP, map, dif_pos hQ] at hPQ + have hx0 : (I.mapXY Q.x Q.y).1 = (0 : F) := (congrArg SWPoint.x hPQ).symm + have hy0 : (I.mapXY Q.x Q.y).2 = (0 : F) := (congrArg SWPoint.y hPQ).symm + have himg := I.onCurve_mapXY hQ + have hpair : I.mapXY Q.x Q.y = ((0 : F), (0 : F)) := Prod.ext_iff.mpr ⟨hx0, hy0⟩ + rw [hpair] at himg + exact origin_not_on_curve I.codomain himg + · have hP0 : (P.x, P.y) = ((0 : F), (0 : F)) := P.onCurve.resolve_left hP + have hQ0 : (Q.x, Q.y) = ((0 : F), (0 : F)) := Q.onCurve.resolve_left hQ + exact SWPoint.ext_pair (hP0.trans hQ0.symm) + +/-- The isogeny is a bijection on rational points, by counting: it is injective, and +the domain and codomain groups have equal (finite) order. -/ +theorem map_bijective [Fintype F] (h2 : (2 : F) ≠ 0) + (hc : ∀ X : F, ¬ OnCurve I.codomain.A I.codomain.B (X, 0)) + (hcard : Nat.card (SWPoint I.domain) = Nat.card (SWPoint I.codomain)) : + Function.Bijective I.map := by + rw [Fintype.bijective_iff_injective_and_card] + refine ⟨I.map_injective h2 hc, ?_⟩ + rw [Fintype.card_eq_nat_card, Fintype.card_eq_nat_card] + exact hcard + +end ThreeIsogeny + +end CompElliptic.Isogenies diff --git a/CompElliptic/Isogenies/VeluCertificates.lean b/CompElliptic/Isogenies/VeluCertificates.lean new file mode 100644 index 0000000..0d8ddfa --- /dev/null +++ b/CompElliptic/Isogenies/VeluCertificates.lean @@ -0,0 +1,466 @@ +/- +Copyright (c) 2026 CompElliptic Contributors. +Released under the Apache License, Version 2.0, or the MIT license, at your option, +as described in the files LICENSE-APACHE and LICENSE-MIT. +Authors: Daira-Emma Hopwood +-/ +import Mathlib.Tactic.LinearCombination + +/-! +# Certificates for the 3-isogeny homomorphism property + +This module proves the two polynomial identities behind the homomorphism property +of `ThreeIsogeny.map`: the abscissa of the image of a sum agrees with the abscissa +the codomain group law computes from the images. `chord_x_certificate` covers +adding points with distinct abscissas; `tangent_x_certificate` covers doubling. +Both are generic commutative-ring algebra with no geometric content; the geometry +lives in `Isogenies/ThreeIsogeny.lean`. + +## Certificates, cofactors, atoms, and mass + +Each theorem is a *certificate*. The goal is a polynomial equation `G = 0`, and +each hypothesis is an equation `⟨poly⟩ = 0` or `atom = ⟨poly⟩`. Write `hᵢ` for the +difference of the two sides of hypothesis `i`. The proof supplies *cofactor* +polynomials `c₁, …, cₖ` with `G = c₁·h₁ + ⋯ + cₖ·hₖ`. That equation is exactly what +`linear_combination` checks, by normalizing both sides with `ring`; the cofactors +are the entire proof input. They were computed in Sage by +`scripts/gen_velu_certificates.sage`, which re-verifies the emitted identity by +exact polynomial expansion before writing the Lean text, and Lean re-checks the +same identity on every build — so no Gröbner-basis output is trusted. + +An *atom* is a variable standing for a named subexpression, with a defining +hypothesis such as `hns` below. Atoms keep the statement small: the goal and the +cofactors refer to the subexpression by name instead of expanding through it. +Size is what makes these proofs feasible: the running time of `ring` is driven by +the number of monomials in the statement, and secondarily by the certificate's +*mass* `Σᵢ |cᵢ|·|hᵢ|` (counting monomials). The coordinates below reduce the chord +certificate's mass roughly sevenfold and bring its goal from 151 monomials to 66, +which is the difference between an infeasible proof and one that elaborates in +under a minute. + +## Kernel-centred coordinates + +Both statements use the translation that puts the kernel abscissa at the origin. +For a point abscissa `x` the certificate sees `d = x - x₀`, and a line +`y = l·x + m` becomes `y = l·d + m'` with the centred intercept `m' = m + l·x₀`; +the slope is unchanged. The translation is a ring automorphism, so a certificate +in the original variables transports term-for-term. + +Centring shrinks everything because the isogeny is built around `x₀`. Its +denominators are `x - x₀`, which become bare `d`. Vélu's numerators written in `d` +are short: `xnum = d³ + x₀·d² + 2p·d + 4g₀` and `ynum = d³ - 2p·d - 8g₀`, where +`p = 3x₀² + A` and `g₀ = x₀³ + A·x₀ + B` are the derivative and the value of the +curve cubic at the kernel. The powers of `x - x₀` never expand into `x, x₀` +cross-terms, which were most of the bulk in the original variables. The curve +cubic near the kernel becomes `d³ + 3x₀·d² + p·d + g₀` —its coefficients are the +Taylor coefficients at `x₀`— and the division-polynomial relation `ψ₃(x₀) = 0` +becomes the two-term relation `p² = 12·x₀·g₀`. + +## Symmetric variables and the atoms + +The chord statement also works in symmetric variables for the two summands: +`e = d₁ + d₂` and `dd = d₁ - d₂`. Over the common denominators, the difference of +the image abscissas has numerator `xnum(x₂)·d₁² - xnum(x₁)·d₂²`, and the +difference of the image ordinates has numerator +`y(x₂)·ynum(x₂)·d₁³ - y(x₁)·ynum(x₁)·d₂³`. Both are antisymmetric under swapping +the points, so `dd` divides them; the atoms `ns` and `ws` are those quotients. +The goal and the `ψ₃` hypothesis are symmetric, the atoms and their cofactors are +antisymmetric, and every product in the certificate is even in `dd`. The halves +from `d₁ = (e + dd)/2` are cleared by powers of 2 —visible as the `(2 : F)^k` +factors in the atom hypotheses and an overall scaling of the goal— which a +consumer cancels using `(2 : F) ≠ 0`. The tangent statement has one point and no +symmetry; its atoms `k` and `t` are described at the theorem. + +The `s`-scaling of the isogeny stays out of both certificates: the scaled +identity is a power of `s` times the unscaled one, reintroduced by the consumer. + +## Support lemmas for the wrapper + +The generated section also carries support lemmas for the chord wrapper, in the +same coordinates. Their hypotheses are the two curve-membership relations with the +chord line substituted for the ordinates (`hR1`, `hR2`) and the +division-polynomial relation (`hpsi`). `chord_psi3_bridge` derives the +certificate's `hp` input. `chord_ns_semantics` and `chord_ws_semantics` relate the +certificate's atom polynomials to the same quotients written with the true curve +coefficients. `chord_final_correction` ties the slope-free cleared form of the +target equation to the certificate's goal. Each carries one factor of `dd` —the +Vieta elimination of the curve coefficients through the line holds only after +saturating by the abscissa difference— and 2-power factors from clearing, all +cancelled by the consumer. +-/ + +namespace CompElliptic.Isogenies + +-- The declarations below are generated by `scripts/gen_velu_certificates.sage`; +-- edit and re-run that script rather than editing them here. + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The chord case of the homomorphism identity: the two summands have distinct +abscissas. `hp` is the division-polynomial relation `ψ₃(x₀) = 0`; `hns` and `hws` +define the atoms, scaled by the power of 2 that clears the symmetric change's +halves. The goal is the denominator-cleared statement that the image of the +chord's third abscissa is the abscissa the codomain chord computes from the two +image points. -/ +theorem chord_x_certificate {F : Type*} [CommRing F] + (e dd l m' x0 ns ws : F) + (hp : (-16*e^2*l^4 + 24*e^3*l^2 + 8*e*dd^2*l^2 - 64*e*l^3*m' + 48*e^2*l^2*x0 + + 48*dd^2*l^2*x0 - 9*e^4 - 6*e^2*dd^2 - dd^4 + 48*e^2*l*m' + 16*dd^2*l*m' - + 64*l^2*m'^2 - 24*e^3*x0 - 72*e*dd^2*x0 + 192*e*l*m'*x0 - 144*dd^2*x0^2 + + 192*m'^2*x0) = 0) + (hns : (2 : F)^4 * ns = -8*e^3*l^2 + 8*e*dd^2*l^2 + 9*e^4 - 10*e^2*dd^2 + dd^4 + 16*e^2*l*m' - + 16*dd^2*l*m' + 24*e^3*x0 - 24*e*dd^2*x0 + 64*e*m'^2) + (hws : (2 : F)^6 * ws = 24*e^5*l^3 - 48*e^3*dd^2*l^3 + 24*e*dd^4*l^3 - 27*e^6*l + 57*e^4*dd^2*l - + 33*e^2*dd^4*l + 3*dd^6*l + 48*e^4*l^2*m' - 48*dd^4*l^2*m' - 72*e^5*l*x0 + + 144*e^3*dd^2*l*x0 - 72*e*dd^4*l*x0 - 72*e^5*m' + 48*e^3*dd^2*m' + 24*e*dd^4*m' - + 192*e^3*l*m'^2 + 192*e*dd^2*l*m'^2 - 192*e^4*m'*x0 + 96*e^2*dd^2*m'*x0 + + 96*dd^4*m'*x0 - 384*e^2*m'^3 - 128*dd^2*m'^3) : + (64*e^4*dd^2*l^6*ns^2 - 640*e^2*dd^4*l^6*ns^2 + 576*dd^6*l^6*ns^2 + 128*e^5*dd^2*l^4*ns^2 + + 1280*e^3*dd^4*l^4*ns^2 - 1408*e*dd^6*l^4*ns^2 + 1024*e^3*dd^2*l^5*m'*ns^2 - + 1024*e*dd^4*l^5*m'*ns^2 - 384*e^4*dd^2*l^4*x0*ns^2 + 5376*e^2*dd^4*l^4*x0*ns^2 - + 4992*dd^6*l^4*x0*ns^2 - 480*e^6*dd^2*l^2*ns^2 - 544*e^4*dd^4*l^2*ns^2 + + 992*e^2*dd^6*l^2*ns^2 + 32*dd^8*l^2*ns^2 - 1792*e^4*dd^2*l^3*m'*ns^2 + + 1536*e^2*dd^4*l^3*m'*ns^2 + 256*dd^6*l^3*m'*ns^2 + 2048*e^2*dd^2*l^4*m'^2*ns^2 + + 2048*dd^4*l^4*m'^2*ns^2 - 1152*e^5*dd^2*l^2*x0*ns^2 - 6912*e^3*dd^4*l^2*x0*ns^2 + + 8064*e*dd^6*l^2*x0*ns^2 - 6144*e^3*dd^2*l^3*m'*x0*ns^2 + 6144*e*dd^4*l^3*m'*x0*ns^2 + + 576*e^4*dd^2*l^2*x0^2*ns^2 - 14976*e^2*dd^4*l^2*x0^2*ns^2 + 14400*dd^6*l^2*x0^2*ns^2 + + 288*e^7*dd^2*ns^2 - 96*e^5*dd^4*ns^2 - 160*e^3*dd^6*ns^2 - 32*e*dd^8*ns^2 + + 768*e^5*dd^2*l*m'*ns^2 - 512*e^3*dd^4*l*m'*ns^2 - 256*e*dd^6*l*m'*ns^2 - + 4096*e^3*dd^2*l^2*m'^2*ns^2 - 4096*e*dd^4*l^2*m'^2*ns^2 + 1632*e^6*dd^2*x0*ns^2 + + 1248*e^4*dd^4*x0*ns^2 - 2784*e^2*dd^6*x0*ns^2 - 96*dd^8*x0*ns^2 + + 5376*e^4*dd^2*l*m'*x0*ns^2 - 4608*e^2*dd^4*l*m'*x0*ns^2 - 768*dd^6*l*m'*x0*ns^2 - + 12288*e^2*dd^2*l^2*m'^2*x0*ns^2 - 12288*dd^4*l^2*m'^2*x0*ns^2 + 2304*e^5*dd^2*x0^2*ns^2 + + 9216*e^3*dd^4*x0^2*ns^2 - 11520*e*dd^6*x0^2*ns^2 + 9216*e^3*dd^2*l*m'*x0^2*ns^2 - + 9216*e*dd^4*l*m'*x0^2*ns^2 + 13824*e^2*dd^4*x0^3*ns^2 - 13824*dd^6*x0^3*ns^2 + + 2304*e^4*dd^2*m'^2*ns^2 + 1536*e^2*dd^4*m'^2*ns^2 + 256*dd^6*m'^2*ns^2 + + 12288*e^3*dd^2*m'^2*x0*ns^2 + 12288*e*dd^4*m'^2*x0*ns^2 + 18432*e^2*dd^2*m'^2*x0^2*ns^2 + + 18432*dd^4*m'^2*x0^2*ns^2 - 1024*dd^2*l^4*ws^2 + 2048*e*dd^2*l^2*ws^2 + + 6144*dd^2*l^2*x0*ws^2 - 1024*e^2*dd^2*ws^2 - 6144*e*dd^2*x0*ws^2 - 9216*dd^2*x0^2*ws^2) + = 0 := + by + linear_combination + (-24*e^4*dd^2*l^3*m'*ns + 48*e^2*dd^4*l^3*m'*ns - 24*dd^6*l^3*m'*ns - + 120*e^5*dd^2*l^2*x0*ns + 240*e^3*dd^4*l^2*x0*ns - 120*e*dd^6*l^2*x0*ns + + 24*e^5*dd^2*l*m'*ns - 48*e^3*dd^4*l*m'*ns + 24*e*dd^6*l*m'*ns - 64*e^3*dd^2*l^2*m'^2*ns + + 64*e*dd^4*l^2*m'^2*ns + 135*e^6*dd^2*x0*ns - 285*e^4*dd^4*x0*ns + 165*e^2*dd^6*x0*ns - + 15*dd^8*x0*ns + 312*e^4*dd^2*l*m'*x0*ns - 624*e^2*dd^4*l*m'*x0*ns + 312*dd^6*l*m'*x0*ns + + 360*e^5*dd^2*x0^2*ns - 720*e^3*dd^4*x0^2*ns + 360*e*dd^6*x0^2*ns + 48*e^4*dd^2*m'^2*ns + - 32*e^2*dd^4*m'^2*ns - 16*dd^6*m'^2*ns + 1152*e^3*dd^2*m'^2*x0*ns - + 1152*e*dd^4*m'^2*x0*ns + 32*e^2*dd^2*l^2*ns^2 - 32*dd^4*l^2*ns^2 + 32*e^2*dd^2*l^2*m'*ws + - 32*dd^4*l^2*m'*ws - 32*e^3*dd^2*ns^2 + 32*e*dd^4*ns^2 - 336*e^2*dd^2*x0*ns^2 + + 336*dd^4*x0*ns^2 - 32*e^3*dd^2*m'*ws + 32*e*dd^4*m'*ws - 96*e^2*dd^2*m'*x0*ws + + 96*dd^4*m'*x0*ws) * hp + + (36*e^4*dd^2*l^6*ns - 72*e^2*dd^4*l^6*ns + 36*dd^6*l^6*ns - 72*e^5*dd^2*l^4*ns + + 144*e^3*dd^4*l^4*ns - 72*e*dd^6*l^4*ns + 192*e^3*dd^2*l^5*m'*ns - 192*e*dd^4*l^5*m'*ns - + 456*e^4*dd^2*l^4*x0*ns + 672*e^2*dd^4*l^4*x0*ns - 216*dd^6*l^4*x0*ns + + 36*e^6*dd^2*l^2*ns - 72*e^4*dd^4*l^2*ns + 36*e^2*dd^6*l^2*ns - 336*e^4*dd^2*l^3*m'*ns + + 288*e^2*dd^4*l^3*m'*ns + 48*dd^6*l^3*m'*ns + 256*e^2*dd^2*l^4*m'^2*ns + + 576*e^5*dd^2*l^2*x0*ns - 672*e^3*dd^4*l^2*x0*ns + 96*e*dd^6*l^2*x0*ns - + 2112*e^3*dd^2*l^3*m'*x0*ns + 2112*e*dd^4*l^3*m'*x0*ns + 1044*e^4*dd^2*l^2*x0^2*ns - + 648*e^2*dd^4*l^2*x0^2*ns - 396*dd^6*l^2*x0^2*ns + 144*e^5*dd^2*l*m'*ns - + 96*e^3*dd^4*l*m'*ns - 48*e*dd^6*l*m'*ns - 384*e^3*dd^2*l^2*m'^2*ns - + 128*e*dd^4*l^2*m'^2*ns - 135*e^6*dd^2*x0*ns + 45*e^4*dd^4*x0*ns + 75*e^2*dd^6*x0*ns + + 15*dd^8*x0*ns + 1728*e^4*dd^2*l*m'*x0*ns - 1344*e^2*dd^4*l*m'*x0*ns - + 384*dd^6*l*m'*x0*ns - 2496*e^2*dd^2*l^2*m'^2*x0*ns + 960*dd^4*l^2*m'^2*x0*ns - + 360*e^5*dd^2*x0^2*ns - 720*e^3*dd^4*x0^2*ns + 1080*e*dd^6*x0^2*ns + + 4608*e^3*dd^2*l*m'*x0^2*ns - 4608*e*dd^4*l*m'*x0^2*ns - 2160*e^2*dd^4*x0^3*ns + + 2160*dd^6*x0^3*ns - 48*e^2*dd^2*l^5*ws + 48*dd^4*l^5*ws + 144*e^4*dd^2*m'^2*ns + + 96*e^2*dd^4*m'^2*ns + 16*dd^6*m'^2*ns + 1152*e^3*dd^2*m'^2*x0*ns + 384*e*dd^4*m'^2*x0*ns + + 5184*e^2*dd^2*m'^2*x0^2*ns - 2880*dd^4*m'^2*x0^2*ns + 96*e^3*dd^2*l^3*ws - + 96*e*dd^4*l^3*ws - 128*e*dd^2*l^4*m'*ws + 288*e^2*dd^2*l^3*x0*ws - 288*dd^4*l^3*x0*ws - + 48*e^4*dd^2*l*ws + 48*e^2*dd^4*l*ws + 224*e^2*dd^2*l^2*m'*ws + 32*dd^4*l^2*m'*ws - + 288*e^3*dd^2*l*x0*ws + 288*e*dd^4*l*x0*ws + 768*e*dd^2*l^2*m'*x0*ws - + 432*e^2*dd^2*l*x0^2*ws + 432*dd^4*l*x0^2*ws - 96*e^3*dd^2*m'*ws - 32*e*dd^4*m'*ws - + 672*e^2*dd^2*m'*x0*ws - 96*dd^4*m'*x0*ws - 1152*e*dd^2*m'*x0^2*ws) * hns + + (12*e^2*dd^2*l^5*ns - 12*dd^4*l^5*ns - 24*e^3*dd^2*l^3*ns + 24*e*dd^4*l^3*ns + + 32*e*dd^2*l^4*m'*ns - 72*e^2*dd^2*l^3*x0*ns + 72*dd^4*l^3*x0*ns + 12*e^4*dd^2*l*ns - + 12*e^2*dd^4*l*ns - 56*e^2*dd^2*l^2*m'*ns - 8*dd^4*l^2*m'*ns + 72*e^3*dd^2*l*x0*ns - + 72*e*dd^4*l*x0*ns - 192*e*dd^2*l^2*m'*x0*ns + 108*e^2*dd^2*l*x0^2*ns - + 108*dd^4*l*x0^2*ns + 24*e^3*dd^2*m'*ns + 8*e*dd^4*m'*ns + 168*e^2*dd^2*m'*x0*ns + + 24*dd^4*m'*x0*ns + 288*e*dd^2*m'*x0^2*ns - 16*dd^2*l^4*ws + 32*e*dd^2*l^2*ws + + 96*dd^2*l^2*x0*ws - 16*e^2*dd^2*ws - 96*e*dd^2*x0*ws - 144*dd^2*x0^2*ws) * hws + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The certificate's `hp` input, derived from the geometry: modulo the two +line-substituted curve relations and `ψ₃(x₀) = 0`, the polynomial that +`chord_x_certificate` takes as `hp` vanishes. Carries one saturation factor of +`dd` —the Vieta elimination of the curve coefficients through the line holds only +after saturating by the abscissa difference— and a 2-power from clearing, both +cancelled by the consumer. -/ +theorem chord_psi3_bridge {F : Type*} [CommRing F] + (e dd l m' x0 A B : F) + (hR1 : (2*e^2*l^2 + 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 - 3*e^2*dd - 3*e*dd^2 - dd^3 + 8*e*l*m' + + 8*dd*l*m' - 6*e^2*x0 - 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 - 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A - 4*dd*A - 8*x0*A - 8*B) = 0) + (hR2 : (2*e^2*l^2 - 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 + 3*e^2*dd - 3*e*dd^2 + dd^3 + 8*e*l*m' - + 8*dd*l*m' - 6*e^2*x0 + 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 + 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A + 4*dd*A - 8*x0*A - 8*B) = 0) + (hpsi : 3*x0^4 + 6*A*x0^2 + 12*B*x0 - A^2 = 0) : + dd * (2 : F)^1 * (-16*e^2*l^4 + 24*e^3*l^2 + 8*e*dd^2*l^2 - 64*e*l^3*m' + 48*e^2*l^2*x0 + 48*dd^2*l^2*x0 - + 9*e^4 - 6*e^2*dd^2 - dd^4 + 48*e^2*l*m' + 16*dd^2*l*m' - 64*l^2*m'^2 - 24*e^3*x0 - + 72*e*dd^2*x0 + 192*e*l*m'*x0 - 144*dd^2*x0^2 + 192*m'^2*x0) + = 0 := + by + linear_combination + (-4*e*l^2 + 3*e^2 + dd^2 - 8*l*m' - 12*e*x0 + 24*dd*x0 - 12*x0^2 - 4*A) * hR1 + + (4*e*l^2 - 3*e^2 - dd^2 + 8*l*m' + 12*e*x0 + 24*dd*x0 + 12*x0^2 + 4*A) * hR2 + + (32*dd) * hpsi + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The meaning of the `ns` atom: the symmetric quotient of the image-abscissa +difference numerator, written with the true curve coefficients `A` and `B`, +agrees with the certificate's atom polynomial, which has the coefficients +eliminated through the line. Scaled by one `dd` and by 2-powers, both cancelled +by the consumer. -/ +theorem chord_ns_semantics {F : Type*} [CommRing F] + (e dd l m' x0 A B : F) + (hR1 : (2*e^2*l^2 + 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 - 3*e^2*dd - 3*e*dd^2 - dd^3 + 8*e*l*m' + + 8*dd*l*m' - 6*e^2*x0 - 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 - 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A - 4*dd*A - 8*x0*A - 8*B) = 0) + (hR2 : (2*e^2*l^2 - 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 + 3*e^2*dd - 3*e*dd^2 + dd^3 + 8*e*l*m' - + 8*dd*l*m' - 6*e^2*x0 + 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 + 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A + 4*dd*A - 8*x0*A - 8*B) = 0) : + dd * (2 : F)^4 * (-e^4 + 2*e^2*dd^2 - dd^4 + 24*e^2*x0^2 - 24*dd^2*x0^2 + 64*e*x0^3 + 8*e^2*A - 8*dd^2*A + + 64*e*x0*A + 64*e*B) + = dd * (2 : F)^4 * (-8*e^3*l^2 + 8*e*dd^2*l^2 + 9*e^4 - 10*e^2*dd^2 + dd^4 + 16*e^2*l*m' - 16*dd^2*l*m' + + 24*e^3*x0 - 24*e*dd^2*x0 + 64*e*m'^2) := + by + linear_combination + (48*e^2 - 64*e*dd + 16*dd^2) * hR1 + + (-48*e^2 - 64*e*dd - 16*dd^2) * hR2 + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The meaning of the `ws` atom: the symmetric quotient of the image-ordinate +difference numerator, written with the true curve coefficients, agrees with the +certificate's atom polynomial. Scaled like `chord_ns_semantics`. -/ +theorem chord_ws_semantics {F : Type*} [CommRing F] + (e dd l m' x0 A B : F) + (hR1 : (2*e^2*l^2 + 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 - 3*e^2*dd - 3*e*dd^2 - dd^3 + 8*e*l*m' + + 8*dd*l*m' - 6*e^2*x0 - 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 - 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A - 4*dd*A - 8*x0*A - 8*B) = 0) + (hR2 : (2*e^2*l^2 - 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 + 3*e^2*dd - 3*e*dd^2 + dd^3 + 8*e*l*m' - + 8*dd*l*m' - 6*e^2*x0 + 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 + 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A + 4*dd*A - 8*x0*A - 8*B) = 0) : + dd * (2 : F)^6 * (-e^6*l + 3*e^4*dd^2*l - 3*e^2*dd^4*l + dd^6*l - 24*e^4*l*x0^2 + 48*e^2*dd^2*l*x0^2 - + 24*dd^4*l*x0^2 - 128*e^3*l*x0^3 + 128*e*dd^2*l*x0^3 - 96*e^3*m'*x0^2 + 96*e*dd^2*m'*x0^2 - + 384*e^2*m'*x0^3 - 128*dd^2*m'*x0^3 - 8*e^4*l*A + 16*e^2*dd^2*l*A - 8*dd^4*l*A - + 128*e^3*l*x0*A + 128*e*dd^2*l*x0*A - 32*e^3*m'*A + 32*e*dd^2*m'*A - 384*e^2*m'*x0*A - + 128*dd^2*m'*x0*A - 128*e^3*l*B + 128*e*dd^2*l*B - 384*e^2*m'*B - 128*dd^2*m'*B) + = dd * (2 : F)^6 * (24*e^5*l^3 - 48*e^3*dd^2*l^3 + 24*e*dd^4*l^3 - 27*e^6*l + 57*e^4*dd^2*l - 33*e^2*dd^4*l + + 3*dd^6*l + 48*e^4*l^2*m' - 48*dd^4*l^2*m' - 72*e^5*l*x0 + 144*e^3*dd^2*l*x0 - + 72*e*dd^4*l*x0 - 72*e^5*m' + 48*e^3*dd^2*m' + 24*e*dd^4*m' - 192*e^3*l*m'^2 + + 192*e*dd^2*l*m'^2 - 192*e^4*m'*x0 + 96*e^2*dd^2*m'*x0 + 96*dd^4*m'*x0 - 384*e^2*m'^3 - + 128*dd^2*m'^3) := + by + linear_combination + (-448*e^4*l + 512*e^3*dd*l + 384*e^2*dd^2*l - 512*e*dd^3*l + 64*dd^4*l - 1280*e^3*m' + + 1536*e^2*dd*m' - 768*e*dd^2*m' + 512*dd^3*m') * hR1 + + (448*e^4*l + 512*e^3*dd*l - 384*e^2*dd^2*l - 512*e*dd^3*l - 64*dd^4*l + 1280*e^3*m' + + 1536*e^2*dd*m' + 768*e*dd^2*m' + 512*dd^3*m') * hR2 + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The correction closing the wrapper's final step: the slope-free cleared form +of the target equation differs from the certificate's goal instance by +`dd² · C · ns²`, where `C` is the polynomial here and the matching `ws²` gap +vanishes identically (asserted by the generator). This lemma proves `C` vanishes +modulo the same relations, after one `dd` saturation factor and a 2-power from +clearing. -/ +theorem chord_final_correction {F : Type*} [CommRing F] + (e dd l m' x0 A B : F) + (hR1 : (2*e^2*l^2 + 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 - 3*e^2*dd - 3*e*dd^2 - dd^3 + 8*e*l*m' + + 8*dd*l*m' - 6*e^2*x0 - 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 - 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A - 4*dd*A - 8*x0*A - 8*B) = 0) + (hR2 : (2*e^2*l^2 - 4*e*dd*l^2 + 2*dd^2*l^2 - e^3 + 3*e^2*dd - 3*e*dd^2 + dd^3 + 8*e*l*m' - + 8*dd*l*m' - 6*e^2*x0 + 12*e*dd*x0 - 6*dd^2*x0 - 12*e*x0^2 + 12*dd*x0^2 - 8*x0^3 + + 8*m'^2 - 4*e*A + 4*dd*A - 8*x0*A - 8*B) = 0) + (hpsi : 3*x0^4 + 6*A*x0^2 + 12*B*x0 - A^2 = 0) : + dd * (512*e^2*dd^2*l^6 - 512*dd^4*l^6 - 256*e^5*l^4 - 1024*e^3*dd^2*l^4 + 1280*e*dd^4*l^4 - + 1024*e^3*l^5*m' + 1024*e*dd^2*l^5*m' - 4608*e^2*dd^2*l^4*x0 + 4608*dd^4*l^4*x0 + + 1536*e^3*l^4*x0^2 - 1536*e*dd^2*l^4*x0^2 + 2048*e^2*l^4*x0^3 + 2048*dd^2*l^4*x0^3 + + 544*e^6*l^2 + 416*e^4*dd^2*l^2 - 928*e^2*dd^4*l^2 - 32*dd^6*l^2 + 1792*e^4*l^3*m' - + 1536*e^2*dd^2*l^3*m' - 256*dd^4*l^3*m' - 2048*e^2*l^4*m'^2 - 2048*dd^2*l^4*m'^2 + + 1536*e^5*l^2*x0 + 6144*e^3*dd^2*l^2*x0 - 7680*e*dd^4*l^2*x0 + 6144*e^3*l^3*m'*x0 - + 6144*e*dd^2*l^3*m'*x0 - 2688*e^4*l^2*x0^2 + 16128*e^2*dd^2*l^2*x0^2 - 13440*dd^4*l^2*x0^2 + - 13312*e^3*l^2*x0^3 + 5120*e*dd^2*l^2*x0^3 - 12288*e^2*l^2*x0^4 - 12288*dd^2*l^2*x0^4 + + 512*e^3*l^4*A - 512*e*dd^2*l^4*A + 2048*e^2*l^4*x0*A + 2048*dd^2*l^4*x0*A - 288*e^7 + + 96*e^5*dd^2 + 160*e^3*dd^4 + 32*e*dd^6 - 768*e^5*l*m' + 512*e^3*dd^2*l*m' + + 256*e*dd^4*l*m' + 4096*e^3*l^2*m'^2 + 4096*e*dd^2*l^2*m'^2 - 1632*e^6*x0 - + 1248*e^4*dd^2*x0 + 2784*e^2*dd^4*x0 + 96*dd^6*x0 - 5376*e^4*l*m'*x0 + + 4608*e^2*dd^2*l*m'*x0 + 768*dd^4*l*m'*x0 + 12288*e^2*l^2*m'^2*x0 + 12288*dd^2*l^2*m'^2*x0 + - 1152*e^5*x0^2 - 9984*e^3*dd^2*x0^2 + 11136*e*dd^4*x0^2 - 9216*e^3*l*m'*x0^2 + + 9216*e*dd^2*l*m'*x0^2 + 10368*e^4*x0^3 - 19200*e^2*dd^2*x0^3 + 12928*dd^4*x0^3 + + 26112*e^3*x0^4 - 1536*e*dd^2*x0^4 + 18432*e^2*x0^5 + 18432*dd^2*x0^5 - 896*e^4*l^2*A + + 768*e^2*dd^2*l^2*A + 128*dd^4*l^2*A - 7168*e^3*l^2*x0*A - 1024*e*dd^2*l^2*x0*A - + 12288*e^2*l^2*x0^2*A - 12288*dd^2*l^2*x0^2*A + 2048*e^2*l^4*B + 2048*dd^2*l^4*B - + 2304*e^4*m'^2 - 1536*e^2*dd^2*m'^2 - 256*dd^4*m'^2 - 12288*e^3*m'^2*x0 - + 12288*e*dd^2*m'^2*x0 - 18432*e^2*m'^2*x0^2 - 18432*dd^2*m'^2*x0^2 + 384*e^5*A - + 256*e^3*dd^2*A - 128*e*dd^4*A + 4992*e^4*x0*A - 768*e^2*dd^2*x0*A - 128*dd^4*x0*A + + 16896*e^3*x0^2*A + 7680*e*dd^2*x0^2*A + 18432*e^2*x0^3*A + 18432*dd^2*x0^3*A - + 4096*e^3*l^2*B - 4096*e*dd^2*l^2*B - 12288*e^2*l^2*x0*B - 12288*dd^2*l^2*x0*B + 2304*e^4*B + + 1536*e^2*dd^2*B + 256*dd^4*B + 12288*e^3*x0*B + 12288*e*dd^2*x0*B + 18432*e^2*x0^2*B + + 18432*dd^2*x0^2*B) + = 0 := + by + linear_combination + (128*e*dd^2*l^4 - 128*dd^3*l^4 - 32*e^4*l^2 - 64*e^2*dd^2*l^2 + 96*dd^4*l^2 - + 128*e^2*l^3*m' + 128*dd^2*l^3*m' - 768*e*dd^2*l^2*x0 + 768*dd^3*l^2*x0 + + 192*e^2*l^2*x0^2 - 192*dd^2*l^2*x0^2 + 256*e*l^2*x0^3 + 56*e^5 - 24*e^4*dd - 48*e^3*dd^2 + + 112*e^2*dd^3 - 136*e*dd^4 + 40*dd^5 + 256*e^3*l*m' - 128*e^2*dd*l*m' + 256*e*dd^2*l*m' + - 384*dd^3*l*m' + 256*e*l^2*m'^2 - 512*dd*l^2*m'^2 + 96*e^4*x0 + 192*e^2*dd^2*x0 - + 288*dd^4*x0 + 384*e^2*l*m'*x0 - 384*dd^2*l*m'*x0 - 384*e^3*x0^2 + 192*e^2*dd*x0^2 + + 768*e*dd^2*x0^2 - 576*dd^3*x0^2 - 1536*e*l*m'*x0^2 + 1536*dd*l*m'*x0^2 - 896*e^2*x0^3 + + 128*dd^2*x0^3 - 512*l*m'*x0^3 + 64*e^2*l^2*A - 64*dd^2*l^2*A + 256*e*l^2*x0*A + + 320*e^2*m'^2 + 448*dd^2*m'^2 + 512*l*m'^3 + 768*e*m'^2*x0 - 768*m'^2*x0^2 - 128*e^3*A + + 64*e^2*dd*A - 128*e*dd^2*A + 192*dd^3*A - 512*e*l*m'*A + 512*dd*l*m'*A - 512*e^2*x0*A - + 256*dd^2*x0*A - 512*l*m'*x0*A - 768*e*x0^2*A + 1536*dd*x0^2*A - 512*x0^3*A + 256*e*l^2*B + - 256*m'^2*A + 256*e*A^2 - 512*dd*A^2 + 512*x0*A^2 - 320*e^2*B - 448*dd^2*B - 512*l*m'*B + - 2304*e*x0*B + 4608*dd*x0*B - 2304*x0^2*B + 256*A*B) * hR1 + + (-128*e*dd^2*l^4 - 128*dd^3*l^4 + 32*e^4*l^2 + 64*e^2*dd^2*l^2 - 96*dd^4*l^2 + + 128*e^2*l^3*m' - 128*dd^2*l^3*m' + 768*e*dd^2*l^2*x0 + 768*dd^3*l^2*x0 - + 192*e^2*l^2*x0^2 + 192*dd^2*l^2*x0^2 - 256*e*l^2*x0^3 - 56*e^5 - 24*e^4*dd + 48*e^3*dd^2 + + 112*e^2*dd^3 + 136*e*dd^4 + 40*dd^5 - 256*e^3*l*m' - 128*e^2*dd*l*m' - 256*e*dd^2*l*m' + - 384*dd^3*l*m' - 256*e*l^2*m'^2 - 512*dd*l^2*m'^2 - 96*e^4*x0 - 192*e^2*dd^2*x0 + + 288*dd^4*x0 - 384*e^2*l*m'*x0 + 384*dd^2*l*m'*x0 + 384*e^3*x0^2 + 192*e^2*dd*x0^2 - + 768*e*dd^2*x0^2 - 576*dd^3*x0^2 + 1536*e*l*m'*x0^2 + 1536*dd*l*m'*x0^2 + 896*e^2*x0^3 - + 128*dd^2*x0^3 + 512*l*m'*x0^3 - 64*e^2*l^2*A + 64*dd^2*l^2*A - 256*e*l^2*x0*A - + 320*e^2*m'^2 - 448*dd^2*m'^2 - 512*l*m'^3 - 768*e*m'^2*x0 + 768*m'^2*x0^2 + 128*e^3*A + + 64*e^2*dd*A + 128*e*dd^2*A + 192*dd^3*A + 512*e*l*m'*A + 512*dd*l*m'*A + 512*e^2*x0*A + + 256*dd^2*x0*A + 512*l*m'*x0*A + 768*e*x0^2*A + 1536*dd*x0^2*A + 512*x0^3*A - 256*e*l^2*B + + 256*m'^2*A - 256*e*A^2 - 512*dd*A^2 - 512*x0*A^2 + 320*e^2*B + 448*dd^2*B + 512*l*m'*B + + 2304*e*x0*B + 4608*dd*x0*B + 2304*x0^2*B - 256*A*B) * hR2 + + (-512*e^2*dd*l^2 - 1536*dd^3*l^2 + 2048*e*dd*l^2*x0 + 2048*e*dd^3 - 4096*e*dd*l*m' + + 4096*dd^3*x0 + 4096*dd*l*m'*x0 - 6144*dd*m'^2 + 2048*e*dd*A + 4096*dd*x0*A + 6144*dd*B) * hpsi + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The tangent case of the homomorphism identity: doubling. `hp` is the +division-polynomial relation `ψ₃(x₀) = 0`; the atoms `k` and `t` are the +numerators of `2·y'` and `3·x'² + A'` —the parts of the codomain doubling +slope— over their `d`-power denominators. The whole identity carries the +factor of 4 that made the cofactors integral. -/ +theorem tangent_x_certificate {F : Type*} [CommRing F] + (d u v' x0 k t : F) + (hp : (-4*d^2*u^4 + 12*d^3*u^2 - 8*d*u^3*v' + 12*d^2*u^2*x0 - 9*d^4 + 12*d^2*u*v' - + 4*u^2*v'^2 - 12*d^3*x0 + 24*d*u*v'*x0 + 12*v'^2*x0) = 0) + (hk : k = (8*d^4*u^3 - 18*d^5*u - 24*d^4*u*x0 - 18*d^4*v' - 24*d^2*u*v'^2 - 24*d^3*v'*x0 - + 16*d*v'^3)) + (ht : t = (-18*d^5*u^2 + 54*d^6 + 54*d^4*u*v' + 48*d^2*u^2*v'^2 + 72*d^5*x0 + + 24*d^3*u*v'*x0 + 72*d^3*v'^2 + 96*d*u*v'^3 + 24*d^2*v'^2*x0 + 48*v'^4)) : + (4*d^2*u^6*k^2 + 16*d^3*u^4*k^2 + 32*d*u^5*v'*k^2 - 24*d^2*u^4*x0*k^2 - 120*d^4*u^2*k^2 - + 112*d^2*u^3*v'*k^2 + 32*u^4*v'^2*k^2 - 144*d^3*u^2*x0*k^2 - 192*d*u^3*v'*x0*k^2 + + 36*d^2*u^2*x0^2*k^2 - 4*d^2*u^4*t^2 + 144*d^5*k^2 + 96*d^3*u*v'*k^2 - 128*d*u^2*v'^2*k^2 + + 408*d^4*x0*k^2 + 336*d^2*u*v'*x0*k^2 - 192*u^2*v'^2*x0*k^2 + 288*d^3*x0^2*k^2 + + 288*d*u*v'*x0^2*k^2 + 16*d^3*u^2*t^2 + 24*d^2*u^2*x0*t^2 + 144*d^2*v'^2*k^2 + + 384*d*v'^2*x0*k^2 + 288*v'^2*x0^2*k^2 - 16*d^4*t^2 - 48*d^3*x0*t^2 - 36*d^2*x0^2*t^2) + = 0 := + by + linear_combination + (-48*d^3*u^4*v'*k - 120*d^4*u^3*x0*k + 36*d^6*u*k + 240*d^4*u^2*v'*k + 40*d^2*u^3*v'^2*k + + 324*d^5*u*x0*k + 288*d^3*u^2*v'*x0*k + 360*d^4*u*x0^2*k + 120*d^5*u^2*t - + 16*d^3*u^3*v'*t - 72*d^4*u^2*x0*t - 126*d^5*v'*k + 240*d^3*u*v'^2*k + 208*d*u^2*v'^3*k - + 36*d^4*v'*x0*k + 744*d^2*u*v'^2*x0*k + 144*d^3*v'*x0^2*k - 390*d^6*t - 400*d^4*u*v'*t - + 376*d^2*u^2*v'^2*t - 360*d^5*x0*t - 96*d^3*u*v'*x0*t + 216*d^4*x0^2*t + 48*d^2*v'^3*k + + 144*u*v'^4*k + 480*d*v'^3*x0*k - 616*d^3*v'^2*t - 816*d*u*v'^3*t - 168*d^2*v'^2*x0*t - + 432*v'^4*t - u^2*k^2 - 7*d*k^2 + 18*x0*k^2 + 9*t^2) * hp + + (24*d*u^5*v'*k + 60*d^2*u^4*x0*k - 45*d^4*u^2*k - 156*d^2*u^3*v'*k + 28*u^4*v'^2*k - + 288*d^3*u^2*x0*k - 24*d*u^3*v'*x0*k - 180*d^2*u^2*x0^2*k + 12*d^3*u^3*t + 8*d*u^4*v'*t + + 36*d^2*u^3*x0*t + 81*d^5*k + 180*d^3*u*v'*k - 156*d*u^2*v'^2*k + 486*d^4*x0*k + + 288*d^2*u*v'*x0*k - 108*u^2*v'^2*x0*k + 504*d^3*x0^2*k - 144*d*u*v'*x0^2*k - 21*d^4*u*t + + 20*d^2*u^2*v'*t + 12*u^3*v'^2*t - 108*d^3*u*x0*t + 24*d*u^2*v'*x0*t - 108*d^2*u*x0^2*t + + 144*d^2*v'^2*k + 468*d*v'^2*x0*k + 72*v'^2*x0^2*k - 48*d^3*v'*t - 168*d^2*v'*x0*t - + 36*u*v'^2*x0*t - 144*d*v'*x0^2*t) * hk + + (-12*d^3*u^3*k - 8*d*u^4*v'*k - 36*d^2*u^3*x0*k + 32*d^2*u^4*t + 21*d^4*u*k - + 20*d^2*u^2*v'*k - 12*u^3*v'^2*k + 108*d^3*u*x0*k - 24*d*u^2*v'*x0*k + 108*d^2*u*x0^2*k - + 92*d^3*u^2*t + 72*d*u^3*v'*t - 84*d^2*u^2*x0*t + 48*d^3*v'*k + 168*d^2*v'*x0*k + + 36*u*v'^2*x0*k + 144*d*v'*x0^2*k + 65*d^4*t - 108*d^2*u*v'*t + 36*u^2*v'^2*t + + 60*d^3*x0*t - 216*d*u*v'*x0*t - 36*d^2*x0^2*t - 108*v'^2*x0*t) * ht + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The certificate's `hp` input for the doubling case: modulo the tangent-line +curve membership and the tangency relation, the polynomial that +`tangent_x_certificate` takes as `hp` vanishes. No saturation factor is needed: +the tangency relation is linear in `A`, so the elimination is clean. -/ +theorem tangent_psi3_bridge {F : Type*} [CommRing F] + (d u v' x0 A B : F) + (hT1 : (d^2*u^2 - d^3 + 2*d*u*v' - 3*d^2*x0 - 3*d*x0^2 - x0^3 + v'^2 - d*A - x0*A - B) = 0) + (hT2 : (2*d*u^2 - 3*d^2 + 2*u*v' - 6*d*x0 - 3*x0^2 - A) = 0) + (hpsi : 3*x0^4 + 6*A*x0^2 + 12*B*x0 - A^2 = 0) : + (-4*d^2*u^4 + 12*d^3*u^2 - 8*d*u^3*v' + 12*d^2*u^2*x0 - 9*d^4 + 12*d^2*u*v' - 4*u^2*v'^2 - + 12*d^3*x0 + 24*d*u*v'*x0 + 12*v'^2*x0) + = 0 := + by + linear_combination + (12*x0) * hT1 + + (-2*d*u^2 + 3*d^2 - 2*u*v' - 6*d*x0 - 3*x0^2 - A) * hT2 + + (1) * hpsi + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The meaning of the `k` atom: `2·y·ynum·d`, written with the true curve +coefficients, agrees with the certificate's polynomial. -/ +theorem tangent_k_semantics {F : Type*} [CommRing F] + (d u v' x0 A B : F) + (hT1 : (d^2*u^2 - d^3 + 2*d*u*v' - 3*d^2*x0 - 3*d*x0^2 - x0^3 + v'^2 - d*A - x0*A - B) = 0) + (hT2 : (2*d*u^2 - 3*d^2 + 2*u*v' - 6*d*x0 - 3*x0^2 - A) = 0) : + (2*d^5*u - 12*d^3*u*x0^2 - 16*d^2*u*x0^3 + 2*d^4*v' - 12*d^2*v'*x0^2 - 16*d*v'*x0^3 - + 4*d^3*u*A - 16*d^2*u*x0*A - 4*d^2*v'*A - 16*d*v'*x0*A - 16*d^2*u*B - 16*d*v'*B) + = (8*d^4*u^3 - 18*d^5*u - 24*d^4*u*x0 - 18*d^4*v' - 24*d^2*u*v'^2 - 24*d^3*v'*x0 - + 16*d*v'^3) := + by + linear_combination + (16*d^2*u + 16*d*v') * hT1 + + (-12*d^3*u - 12*d^2*v') * hT2 + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The meaning of the `t` atom: `3·xnum² + A'·d⁴` —the numerator parts of the +codomain doubling slope— written with the true curve coefficients, agrees with +the certificate's polynomial. -/ +theorem tangent_t_semantics {F : Type*} [CommRing F] + (d u v' x0 A B : F) + (hT1 : (d^2*u^2 - d^3 + 2*d*u*v' - 3*d^2*x0 - 3*d*x0^2 - x0^3 + v'^2 - d*A - x0*A - B) = 0) + (hT2 : (2*d*u^2 - 3*d^2 + 2*u*v' - 6*d*x0 - 3*x0^2 - A) = 0) : + (3*d^6 + 6*d^5*x0 + 9*d^4*x0^2 + 60*d^3*x0^3 + 132*d^2*x0^4 + 144*d*x0^5 + 48*x0^6 + + 3*d^4*A + 36*d^3*x0*A + 96*d^2*x0^2*A + 192*d*x0^3*A + 96*x0^4*A + 12*d^2*A^2 + + 48*d*x0*A^2 + 48*x0^2*A^2 + 24*d^3*B + 24*d^2*x0*B + 144*d*x0^2*B + 96*x0^3*B + 48*d*A*B + + 96*x0*A*B + 48*B^2) + = (-18*d^5*u^2 + 54*d^6 + 54*d^4*u*v' + 48*d^2*u^2*v'^2 + 72*d^5*x0 + 24*d^3*u*v'*x0 + + 72*d^3*v'^2 + 96*d*u*v'^3 + 24*d^2*v'^2*x0 + 48*v'^4) := + by + linear_combination + (-48*d^3 - 48*d*u*v' - 24*d^2*x0 - 72*d*x0^2 - 48*x0^3 - 48*v'^2 - 24*d*A - 48*x0*A - + 48*B) * hT1 + + (33*d^4 + 24*d^2*u*v' + 12*d^3*x0 + 36*d^2*x0^2 + 24*d*x0^3 + 24*d*v'^2 + 12*d^2*A + + 24*d*x0*A + 24*d*B) * hT2 + +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The correction closing the doubling wrapper's final step: the slope-free +cleared form of the target differs from the certificate's goal by `C · k²` for +the polynomial `C` here (the `t²` gap vanishes identically, asserted by the +generator), and `C` vanishes modulo the same relations. -/ +theorem tangent_correction {F : Type*} [CommRing F] + (d u v' x0 A B : F) + (hT1 : (d^2*u^2 - d^3 + 2*d*u*v' - 3*d^2*x0 - 3*d*x0^2 - x0^3 + v'^2 - d*A - x0*A - B) = 0) + (hT2 : (2*d*u^2 - 3*d^2 + 2*u*v' - 6*d*x0 - 3*x0^2 - A) = 0) : + (-32*d^3*u^4 - 32*d*u^5*v' + 48*d*u^4*x0^2 + 32*u^4*x0^3 + 136*d^4*u^2 + 112*d^2*u^3*v' - + 32*u^4*v'^2 + 192*d^3*u^2*x0 + 192*d*u^3*v'*x0 - 168*d^2*u^2*x0^2 - 416*d*u^2*x0^3 - + 192*u^2*x0^4 + 16*d*u^4*A + 32*u^4*x0*A - 144*d^5 - 96*d^3*u*v' + 128*d*u^2*v'^2 - + 408*d^4*x0 - 336*d^2*u*v'*x0 + 192*u^2*v'^2*x0 - 144*d^3*x0^2 - 288*d*u*v'*x0^2 + + 648*d^2*x0^3 + 816*d*x0^4 + 288*x0^5 - 56*d^2*u^2*A - 224*d*u^2*x0*A - 192*u^2*x0^2*A + + 32*u^4*B - 144*d^2*v'^2 - 384*d*v'^2*x0 - 288*v'^2*x0^2 + 48*d^3*A + 312*d^2*x0*A + + 528*d*x0^2*A + 288*x0^3*A - 128*d*u^2*B - 192*u^2*x0*B + 144*d^2*B + 384*d*x0*B + + 288*x0^2*B) + = 0 := + by + linear_combination + (-32*u^4 + 224*d*u^2 + 192*u^2*x0 - 288*d^2 + 96*u*v' - 672*d*x0 - 432*x0^2 - 48*A) * hT1 + + (16*d*u^4 - 120*d^2*u^2 - 96*d*u^2*x0 + 144*d^3 - 96*d*u*v' + 360*d^2*x0 + 288*d*x0^2 + + 48*x0^3 - 48*v'^2 + 48*d*A + 48*x0*A + 48*B) * hT2 + +end CompElliptic.Isogenies diff --git a/CompElliptic/TrustBoundary.lean b/CompElliptic/TrustBoundary.lean index a8bea1d..417c3a7 100644 --- a/CompElliptic/TrustBoundary.lean +++ b/CompElliptic/TrustBoundary.lean @@ -5,6 +5,7 @@ as described in the files LICENSE-APACHE and LICENSE-MIT. Authors: Daira-Emma Hopwood -/ import CompElliptic.Curves.PastaOrder +import CompElliptic.Hashing.PastaSSWU import CompElliptic.Curves.Pasta.Fast.Projective import CompElliptic.Curves.Pasta.Fast.Msm import CompElliptic.Curves.Pasta.Fast.ProjectiveMontEquiv @@ -55,6 +56,16 @@ assert_axioms CompElliptic.Fields.TonelliShanks.sqrt?_isSome_of_isSquare assert_axioms CompElliptic.Fields.Pasta.PALLAS_BASE_is_prime assert_axioms CompElliptic.Fields.Pasta.PALLAS_SCALAR_is_prime +/-! ## The isogeny layer's headline general theorems — standard axioms only -/ + +assert_axioms CompElliptic.Curves.Pasta.Pallas.iso_map_eq +assert_axioms CompElliptic.Curves.Pasta.Vesta.iso_map_eq +assert_axioms CompElliptic.Curves.Pasta.Pallas.onCurve_iso_map +assert_axioms CompElliptic.Curves.Pasta.Vesta.onCurve_iso_map +assert_axioms CompElliptic.Isogenies.ThreeIsogeny.map_add +assert_axioms CompElliptic.Curves.Pasta.Pallas.iso_map_add +assert_axioms CompElliptic.Curves.Pasta.Vesta.iso_map_add + /-! ## Computable point enumeration — the curve group's `Fintype`, as plain data `Classical.choice` enters only through erased `Prop` fields of the Mathlib `Finset` lemmas; @@ -79,6 +90,32 @@ assert_axioms CompElliptic.Curves.Pasta.Pallas.card_eq +native( CompElliptic.Curves.Pasta.Pallas.q_nsmul_Gpt) assert_axioms CompElliptic.Curves.Pasta.Vesta.card_eq +native( CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt) +assert_axioms CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt +native( + CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt) +assert_axioms CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt +native( + CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt) +assert_axioms CompElliptic.Curves.Pasta.Pallas.iso_card_eq +native( + CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt) +assert_axioms CompElliptic.Curves.Pasta.Vesta.iso_card_eq +native( + CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt) +assert_axioms CompElliptic.Curves.Pasta.Pallas.iso_map_bijective +native( + CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt, + CompElliptic.Curves.Pasta.Pallas.q_nsmul_Gpt) +assert_axioms CompElliptic.Curves.Pasta.Vesta.iso_map_bijective +native( + CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt, + CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt) +assert_axioms CompElliptic.Curves.Pasta.Pallas.isOdd_zeroRepaired_mapToCurve +native( + CompElliptic.Fields.Pasta.pallasBase) +assert_axioms CompElliptic.Curves.Pasta.Vesta.isOdd_zeroRepaired_mapToCurve +native( + CompElliptic.Fields.Pasta.vestaBase) +assert_axioms CompElliptic.Curves.Pasta.Pallas.norm_charSum_mapToCurve_sub_zeroRepaired +native( + CompElliptic.Fields.Pasta.pallasBase) +assert_axioms CompElliptic.Curves.Pasta.Vesta.norm_charSum_mapToCurve_sub_zeroRepaired +native( + CompElliptic.Fields.Pasta.vestaBase) +assert_axioms CompElliptic.Curves.Pasta.Pallas.mapHashOutputsToCurve_eq +native( + CompElliptic.Fields.Pasta.pallasBase) +assert_axioms CompElliptic.Curves.Pasta.Vesta.mapHashOutputsToCurve_eq +native( + CompElliptic.Fields.Pasta.vestaBase) /-! ## Fast Vesta arithmetic — proven against the affine group law, standard axioms only diff --git a/design/naming-survey.md b/design/naming-survey.md index da1a7ce..5baf36a 100644 --- a/design/naming-survey.md +++ b/design/naming-survey.md @@ -32,6 +32,7 @@ representation, byte sequence, bit sequence, circuit representation, and coordin | Non-injective coordinates | explicitly **equivalence classes** (projective `(X : Y : Z)` notation signals "a class") | | Conversion to the unique form | **normalize** / `norm`, **to-affine**, **make-affine** | | Byte / wire form | **encoding**, **serialize**, **compress(ed)** / **uncompressed** | +| Deterministic field→curve function (hash-to-curve) | **mapping** / `map_to_curve` (RFC 9380); the underlying papers say "encoding" — see the third-sense caution below | | Affine x, y getters | **coordinates** (a narrow accessor concept, not a type) | | In-circuit value | **variable** / **Var**, **assigned (cell)**, **wire**, **witness** | @@ -237,6 +238,23 @@ The runner-up is to flip the word entirely — "encoding = value" (following zkc naturally at value sites ("a valid encoding") but renames the central structure and diverges from `Encodable`. +### A third sense from the hash-to-curve literature: prefer RFC 9380's "mapping" + +The papers underlying hash-to-curve —Boneh–Franklin's "admissible encoding", its generalization by +Brier et al. (CRYPTO 2010), and Farashahi et al.'s "well-distributed encoding"— use **"encoding"** +for the deterministic field-to-curve functions (simplified SWU, Icart, and relatives). RFC 9380 +renames exactly these objects **mappings** (`map_to_curve`, its section 2.2.1), reserving "encoding" +for the byte-string-to-point composite (`encode_to_curve`). CompElliptic follows RFC 9380: the +`Hashing/` modules say *mapping* for an `f : F → G` under character-sum analysis, and *encoding* +keeps its reserved sense here — the scheme translating group elements into their depictions and +back. The papers' word appears only when citing them (e.g. the References block of +`Hashing/WellDistributed.lean`, where "well-distributed encoding" is Farashahi et al.'s defined +term). + +This sense was absent from the original survey because the repo's hash-to-curve reference was +RFC 9380 rather than the papers it relies on: the RFC had already renamed the clash away, and it +resurfaced only when the character-sum development began citing the underlying literature directly. + ## Implications for CompElliptic naming - The two orthogonal axes have stable names: **curve shape / form** (Weierstrass, Edwards, diff --git a/scripts/gen_velu_certificates.sage b/scripts/gen_velu_certificates.sage new file mode 100644 index 0000000..77b3103 --- /dev/null +++ b/scripts/gen_velu_certificates.sage @@ -0,0 +1,485 @@ +# Regenerates the generated section of CompElliptic/Isogenies/VeluCertificates.lean: +# everything below the marker line near the top of its namespace. The hand-written +# module doc above the marker is left untouched. See that module's doc-comment for +# the coordinate system and the vocabulary (certificate, cofactor, atom, mass); this +# script is the single source for the theorem statements and proofs. +# +# Method, per certificate: +# 1. Build the identity and its hypotheses in line coordinates (the chord or +# tangent line substituted for the ordinates; curve coefficients solved out by +# Vieta; the image-difference blocks as atoms). +# 2. Obtain cofactors with Singular's `lift` over the hypothesis ideal. +# 3. Transport everything through the kernel-centring ring automorphism +# x ↦ d + x₀ (and, for the chord, the symmetric change e = d₁ + d₂, +# dd = d₁ − d₂, with the antisymmetric atoms divided by dd). +# 4. Clear denominators by powers of 2 where the symmetric change introduced +# halves (the tangent transport is integral; its pre-existing factor of 4 comes +# from the lift's denominators). +# 5. Assert the emitted-form identity by exact polynomial expansion — the +# hypothesis contributions exactly as `linear_combination` will read them, +# multiplied by the emitted cofactors, summing to the emitted goal. No +# Gröbner output is trusted: a wrong lift fails this assert, and Lean's +# `ring` normalization independently re-checks the same identity on build. +# 6. Emit with a fixed layout (statement polynomials parenthesized, `by` on its +# own line, tactic arguments strictly deeper) and lint the layout before +# writing. +import re +import textwrap + + +def lw(poly, indent): + s = str(poly) + body = textwrap.wrap(s, width=96 - indent, break_long_words=False, + break_on_hyphens=False) + pad = " " * indent + return ("\n" + pad).join(body) + + +# ---------------------------------------------------------------- chord ---- +R = PolynomialRing(QQ, ["x1", "x2", "l", "m", "x0", "nn", "w"], order="degrevlex") +x1, x2, l, m, x0, nn, w = R.gens() +x3 = l^2 - x1 - x2 +e2 = x1*x2 + x1*x3 + x2*x3 +e3 = x1*x2*x3 +a = 2*l*m + e2 +b = m^2 - e3 +g0 = x0^3 + a*x0 + b +vc = 2*(3*x0^2 + a) +uc = 4*g0 +N = lambda s_: s_*(s_ - x0)^2 + vc*(s_ - x0) + uc +M = lambda s_: (s_ - x0)^3 - vc*(s_ - x0) - 2*uc +D = lambda s_: s_ - x0 +y = lambda s_: l*s_ + m +hp = 3*x0^4 + 6*a*x0^2 + 12*b*x0 - a^2 +NNu = N(x2)*D(x1)^2 - N(x1)*D(x2)^2 +Wu = y(x2)*M(x2)*D(x1)^3 - y(x1)*M(x1)*D(x2)^3 +goal = (N(x3)*D(x1)^2*D(x2)^2*nn^2 + - (w^2 - (N(x1)*D(x2)^2 + N(x2)*D(x1)^2)*nn^2)*D(x3)^2) +cof = goal.lift(R.ideal([hp, nn - NNu, w - Wu])) +assert cof[0]*hp + cof[1]*(nn - NNu) + cof[2]*(w - Wu) == goal + +# Centring + symmetric change; nn and w are antisymmetric, so they carry a factor +# of dd out: the atoms become the quotients ns = nn/dd, ws = w/dd. +A2 = PolynomialRing(QQ, ["e", "dd", "l", "mp", "x0", "ns", "ws"], order="degrevlex") +e_, dd, l2, mp, x02, ns, ws = A2.gens() +sym = R.hom([x02 + (e_ + dd)/2, x02 + (e_ - dd)/2, l2, mp - l2*x02, x02, + dd*ns, dd*ws], A2) +goal_s = sym(goal) +hp_s = sym(hp) +NNs = sym(NNu) // dd +Wus = sym(Wu) // dd +c_hp = sym(cof[0]) +c_nn = sym(cof[1]) // dd +c_w = sym(cof[2]) // dd + + +def dexp(P): + d = lcm([c.denominator() for c in P.coefficients()]) + assert d == 2^(d.valuation(2)), d + return d.valuation(2) + + +v1 = dexp(hp_s); v2 = dexp(NNs); v3 = dexp(Wus) +v0 = max(dexp(goal_s), v1 + dexp(c_hp), v2 + dexp(c_nn), v3 + dexp(c_w)) +hp_i = 2^v1 * hp_s +NNs_i = 2^v2 * NNs +Wus_i = 2^v3 * Wus +goal_i = 2^v0 * goal_s +c1 = 2^(v0 - v1) * c_hp +c2 = dd^2 * 2^(v0 - v2) * c_nn +c3 = dd^2 * 2^(v0 - v3) * c_w +for P in [hp_i, NNs_i, Wus_i, goal_i, c1, c2, c3]: + assert dexp(P) == 0 +# Emitted-form check: hns contributes (2^v2*ns - NNs_i), hws (2^v3*ws - Wus_i). +assert goal_i == c1*hp_i + c2*(2^v2*ns - NNs_i) + c3*(2^v3*ws - Wus_i) +print("chord emitted-form expansion check: PASS") +print("chord sizes: goal", len(goal_i.monomials()), "cofs", + [len(c.monomials()) for c in [c1, c2, c3]]) + +chord_tmpl = """\ +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The chord case of the homomorphism identity: the two summands have distinct +abscissas. `hp` is the division-polynomial relation `ψ₃(x₀) = 0`; `hns` and `hws` +define the atoms, scaled by the power of 2 that clears the symmetric change's +halves. The goal is the denominator-cleared statement that the image of the +chord's third abscissa is the abscissa the codomain chord computes from the two +image points. -/ +theorem chord_x_certificate {{F : Type*}} [CommRing F] + (e dd l m' x0 ns ws : F) + (hp : ({hp}) = 0) + (hns : (2 : F)^{v2} * ns = {nns}) + (hws : (2 : F)^{v3} * ws = {wus}) : + ({goal}) + = 0 := + by + linear_combination + ({c1}) * hp + + ({c2}) * hns + + ({c3}) * hws""" +chord = chord_tmpl.format(hp=lw(hp_i, 14), v2=v2, v3=v3, nns=lw(NNs_i, 16), + wus=lw(Wus_i, 16), goal=lw(goal_i, 6), + c1=lw(c1, 8), c2=lw(c2, 8), c3=lw(c3, 8)) + +# ---------------------------------------------- chord wrapper support ---- +# Support lemmas for the chord wrapper, in the same centred-symmetric coordinates +# as the certificate. The geometric input reduces to three hypotheses in those +# coordinates: the two curve-membership relations with the chord line substituted +# for the ordinates (RC1, RC2, cleared of the halves from d = (e ± dd)/2), and +# psi3. Each lemma lifts over that ideal, with a dd-saturation power where the +# Vieta elimination needs one. The targets: the certificate's own hp polynomial; +# the two identities relating the real-coefficient symmetric quotients to the +# certificate's atom polynomials; and the one nonvanishing correction tying the +# slope-free cleared conclusion to the certificate's goal instance (the ws² +# coefficients agree identically, asserted below). +V = PolynomialRing(QQ, ["e", "dd", "l", "mp", "x0", "A", "B"], order="degrevlex") +ve, vdd, vl, vmp, vx0, vA, vB = V.gens() +d1c = (ve + vdd)/2 +d2c = (ve - vdd)/2 + +def clear2(P): + P = V(P) + j = lcm([c.denominator() for c in P.coefficients()]).valuation(2) + return 2^j * P, j + +gcub = lambda dv: (vx0 + dv)^3 + vA*(vx0 + dv) + vB +RC1_i, _ = clear2((vl*d1c + vmp)^2 - gcub(d1c)) +RC2_i, _ = clear2((vl*d2c + vmp)^2 - gcub(d2c)) +psiV = 3*vx0^4 + 6*vA*vx0^2 + 12*vB*vx0 - vA^2 +cgens = [RC1_i, RC2_i, psiV] +cnames = ["hR1", "hR2", "hpsi"] + +# certificate-side polynomials, coerced into V (they involve no A, B) +toV = A2.hom([ve, vdd, vl, vmp, vx0, V.zero(), V.zero()], V) +hpV = toV(hp_i) +NNsV = toV(NNs_i) +WusV = toV(Wus_i) + +# real-coefficient symmetric quotients (antisymmetric numerators divided by dd) +vAc = 2*(3*vx0^2 + vA) +uAc = 4*(vx0^3 + vA*vx0 + vB) +NAc = lambda dv: (vx0 + dv)*dv^2 + vAc*dv + uAc +MAc = lambda dv: dv^3 - vAc*dv - 2*uAc +yln = lambda dv: vl*dv + vmp +NN_num, jN = clear2(NAc(d2c)*d1c^2 - NAc(d1c)*d2c^2) +WA_num, jW = clear2(yln(d2c)*MAc(d2c)*d1c^3 - yln(d1c)*MAc(d1c)*d2c^3) +NNA_i = NN_num // vdd +WA_i = WA_num // vdd + +# the correction Cns: atom- and ordinate-free, then transported to V +Wc = PolynomialRing(QQ, ["x1", "x2", "l", "mp", "x0", "A", "B", "ns", "ws"], + order="degrevlex") +cx1, cx2, cl, cmp_, cx0, cA, cB, cns, cws = Wc.gens() +instc = A2.hom([(cx1 - cx0) + (cx2 - cx0), cx1 - cx2, cl, cmp_, cx0, cns, cws], Wc) +GpolyC = instc(goal_i) +vAc2 = 2*(3*cx0^2 + cA) +uAc2 = 4*(cx0^3 + cA*cx0 + cB) +NA3 = lambda s_: s_*(s_ - cx0)^2 + vAc2*(s_ - cx0) + uAc2 +x3c = cl^2 - cx1 - cx2 +d3c = x3c - cx0 +FinalPolyC = (NA3(x3c)*(cx1 - cx0)^2*(cx2 - cx0)^2*cns^2 + - (cws^2 - (NA3(cx1)*(cx2 - cx0)^2 + + NA3(cx2)*(cx1 - cx0)^2)*cns^2)*d3c^2) +DeltaC = 2^v0 * (cx1 - cx2)^2 * FinalPolyC - GpolyC +CnsC = DeltaC.coefficient({cns: 2, cws: 0}) +CwsC = DeltaC.coefficient({cns: 0, cws: 2}) +assert DeltaC == CnsC*cns^2 + CwsC*cws^2 +assert CwsC == 0, "the ws^2 correction no longer vanishes" +CnsC = CnsC // (cx1 - cx2)^2 +cenC = Wc.hom([vx0 + d1c, vx0 + d2c, vl, vmp, vx0, vA, vB, V.zero(), V.zero()], V) +Cns_i, jC = clear2(cenC(CnsC)) +print("correction clearing exponent jC =", jC) + +support_parts = [] +support_docs = { + "chord_psi3_bridge": """\ +/-- The certificate's `hp` input, derived from the geometry: modulo the two +line-substituted curve relations and `ψ₃(x₀) = 0`, the polynomial that +`chord_x_certificate` takes as `hp` vanishes. Carries one saturation factor of +`dd` —the Vieta elimination of the curve coefficients through the line holds only +after saturating by the abscissa difference— and a 2-power from clearing, both +cancelled by the consumer. -/""", + "chord_ns_semantics": """\ +/-- The meaning of the `ns` atom: the symmetric quotient of the image-abscissa +difference numerator, written with the true curve coefficients `A` and `B`, +agrees with the certificate's atom polynomial, which has the coefficients +eliminated through the line. Scaled by one `dd` and by 2-powers, both cancelled +by the consumer. -/""", + "chord_ws_semantics": """\ +/-- The meaning of the `ws` atom: the symmetric quotient of the image-ordinate +difference numerator, written with the true curve coefficients, agrees with the +certificate's atom polynomial. Scaled like `chord_ns_semantics`. -/""", + "chord_final_correction": """\ +/-- The correction closing the wrapper's final step: the slope-free cleared form +of the target equation differs from the certificate's goal instance by +`dd² · C · ns²`, where `C` is the polynomial here and the matching `ws²` gap +vanishes identically (asserted by the generator). This lemma proves `C` vanishes +modulo the same relations, after one `dd` saturation factor and a 2-power from +clearing. -/""", +} +support_tmpl = """\ +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +{doc} +theorem {name} {{F : Type*}} [CommRing F] + {vars} +{binders} : + {goal} := + by + linear_combination + {combo}""" +hyp_lines = { + "hR1": " (hR1 : (" + lw(RC1_i, 12) + ") = 0)", + "hR2": " (hR2 : (" + lw(RC2_i, 12) + ") = 0)", + "hpsi": " (hpsi : 3*x0^4 + 6*A*x0^2 + 12*B*x0 - A^2 = 0)", +} +for name, lhs_poly, lhs_pow, rhs_poly, rhs_pow in [ + ("chord_psi3_bridge", hpV, 0, None, 0), + ("chord_ns_semantics", NNA_i, v2, NNsV, jN), + ("chord_ws_semantics", WA_i, v3, WusV, jW), + ("chord_final_correction", Cns_i, 0, None, 0)]: + T0 = lhs_poly * 2^lhs_pow - (rhs_poly * 2^rhs_pow if rhs_poly is not None else 0) + for k in range(4): + T = vdd^k * T0 + try: + lift = T.lift(V.ideal(cgens)) + except ValueError: + continue + assert sum(c*g for c, g in zip(lift, cgens)) == T + break + else: + raise AssertionError(name + " not in ideal") + # scale the whole identity by the cofactors' 2-denominator so the emitted + # coefficients are integers; the consumer cancels with (2 : F) ≠ 0 + dens = [lcm([q.denominator() for q in c.coefficients()]) for c in lift if c != 0] + for d in dens: + assert d == 2^(d.valuation(2)), (name, d) + dj = max([0] + [d.valuation(2) for d in dens]) + lift = [2^dj * c for c in lift] + T = 2^dj * T + assert sum(c*g for c, g in zip(lift, cgens)) == T + assert all(all(q in ZZ for q in c.coefficients()) for c in lift) + lhs_pow += dj + if rhs_poly is not None: + rhs_pow += dj + mass = sum(len(c.monomials())*len(g.monomials()) for c, g in zip(lift, cgens)) + print(name, ": saturation", k, "; cofactors", + [len(c.monomials()) for c in lift], "; mass", mass) + used = [(nm, c) for nm, c in zip(cnames, lift) if c != 0] + combo = "\n + ".join("(" + lw(c, 8) + ") * " + nm for nm, c in used) + sat = "" if k == 0 else ("dd * " if k == 1 else "dd^" + str(k) + " * ") + p2 = lambda j: "" if j == 0 else "(2 : F)^" + str(j) + " * " + if rhs_poly is None: + goal = sat + p2(lhs_pow) + "(" + lw(lhs_poly, 6) + ")\n = 0" + else: + goal = (sat + p2(lhs_pow) + "(" + lw(lhs_poly, 6) + ")\n = " + + sat + p2(rhs_pow) + "(" + lw(rhs_poly, 8) + ")") + support_parts.append(support_tmpl.format( + name=name, doc=support_docs[name], vars="(e dd l m' x0 A B : F)", + binders="\n".join(hyp_lines[nm] for nm, _ in used), + goal=goal, combo=combo)) + +support = "\n\n".join(support_parts) + +# --------------------------------------------------------------- tangent ---- +S = PolynomialRing(QQ, ["z1", "u", "v", "z0", "k", "t"], order="degrevlex") +z1, u, v, z0, k, t = S.gens() +z3 = u^2 - 2*z1 +za = 2*u*v + z1^2 + 2*z1*z3 +zb = v^2 - z1^2*z3 +zg0 = z0^3 + za*z0 + zb +zvc = 2*(3*z0^2 + za) +zuc = 4*zg0 +zN = lambda s_: s_*(s_ - z0)^2 + zvc*(s_ - z0) + zuc +zM = lambda s_: (s_ - z0)^3 - zvc*(s_ - z0) - 2*zuc +zD = lambda s_: s_ - z0 +zy1 = u*z1 + v +zhp = 3*z0^4 + 6*za*z0^2 + 12*zb*z0 - za^2 +zAcod = za - 10*(3*z0^2 + za) +T1x = 3*zN(z1)^2 + zAcod*zD(z1)^4 +K1x = 2*zy1*zM(z1)*zD(z1) +GXD = zN(z3)*k^2*zD(z1)^2 - (t^2*zD(z1)^2 - 2*zN(z1)*k^2)*zD(z3)^2 +# The lift has cofactor denominators of 4; scale the identity by 4 so the emitted +# certificate is integral (the consumer cancels the 4 with (2 : F) ≠ 0). +tcof = [4*c for c in GXD.lift(S.ideal([zhp, k - K1x, t - T1x]))] +GXD4 = 4*GXD +assert tcof[0]*zhp + tcof[1]*(k - K1x) + tcof[2]*(t - T1x) == GXD4 + +S2 = PolynomialRing(QQ, ["d", "u", "vp", "x0", "k", "t"], order="degrevlex") +d2_, u2, vp, x03, k2, t2 = S2.gens() +cen = S.hom([d2_ + x03, u2, vp - u2*x03, x03, k2, t2], S2) +goal_t = cen(GXD4) +zhp_c = cen(zhp) +K1x_c = cen(K1x) +T1x_c = cen(T1x) +tcof_c = [cen(c) for c in tcof] +assert tcof_c[0]*zhp_c + tcof_c[1]*(k2 - K1x_c) + tcof_c[2]*(t2 - T1x_c) == goal_t +assert all(all(cc in ZZ for cc in f.coefficients()) + for f in [goal_t, zhp_c, K1x_c, T1x_c] + tcof_c) +print("tangent emitted-form expansion check: PASS") +print("tangent sizes: goal", len(goal_t.monomials()), "cofs", + [len(c.monomials()) for c in tcof_c]) + +tang_tmpl = """\ +set_option maxHeartbeats 4000000 in +set_option maxRecDepth 8000 in +/-- The tangent case of the homomorphism identity: doubling. `hp` is the +division-polynomial relation `ψ₃(x₀) = 0`; the atoms `k` and `t` are the +numerators of `2·y'` and `3·x'² + A'` —the parts of the codomain doubling +slope— over their `d`-power denominators. The whole identity carries the +factor of 4 that made the cofactors integral. -/ +theorem tangent_x_certificate {{F : Type*}} [CommRing F] + (d u v' x0 k t : F) + (hp : ({hp}) = 0) + (hk : k = ({k1x})) + (ht : t = ({t1x})) : + ({goal}) + = 0 := + by + linear_combination + ({c0}) * hp + + ({c1}) * hk + + ({c2}) * ht""" +tang = tang_tmpl.format(hp=lw(zhp_c, 14), k1x=lw(K1x_c, 16), t1x=lw(T1x_c, 16), + goal=lw(goal_t, 6), c0=lw(tcof_c[0], 8), + c1=lw(tcof_c[1], 8), c2=lw(tcof_c[2], 8)) + +# --------------------------------------------- tangent wrapper support ---- +# Support lemmas for the tangent (doubling) wrapper, mirroring the chord set. The +# generating relations are the curve membership with the tangent line substituted +# (hT1) and the tangency relation (hT2, the derivative condition `2y·u = 3x² + A`, +# linear in A) — so the Vieta elimination is clean and no saturation factors +# appear. The t²-correction vanishes identically (asserted below), leaving one +# k²-correction. +V2 = PolynomialRing(QQ, ["d", "u", "vp", "x0", "A", "B"], order="degrevlex") +td, tu, tvp, tx0, tA, tB = V2.gens() +RT1_p = (tu*td + tvp)^2 - ((tx0 + td)^3 + tA*(tx0 + td) + tB) +RT2_p = 2*tu*(tu*td + tvp) - (3*(tx0 + td)^2 + tA) +psiV2 = 3*tx0^4 + 6*tA*tx0^2 + 12*tB*tx0 - tA^2 +tgens2 = [RT1_p, RT2_p, psiV2] +tnames2 = ["hT1", "hT2", "hpsi"] +toV2 = S2.hom([td, tu, tvp, tx0, V2.zero(), V2.zero()], V2) +hpT = toV2(zhp_c) +K1T = toV2(K1x_c) +T1T = toV2(T1x_c) +tvA = 2*(3*tx0^2 + tA) +tuA = 4*(tx0^3 + tA*tx0 + tB) +NAt = lambda dv: (tx0 + dv)*dv^2 + tvA*dv + tuA +MAt = lambda dv: dv^3 - tvA*dv - 2*tuA +K_real = 2*(tu*td + tvp)*MAt(td)*td +T_real = 3*NAt(td)^2 + (tA - 10*(3*tx0^2 + tA))*td^4 + +Wt = PolynomialRing(QQ, ["d", "u", "vp", "x0", "A", "B", "k", "t"], + order="degrevlex") +wd2, wu2, wvp2, wx02, wA2, wB2, wk2, wt2 = Wt.gens() +instT = S2.hom([wd2, wu2, wvp2, wx02, wk2, wt2], Wt) +GT = instT(goal_t) +wvA2 = 2*(3*wx02^2 + wA2) +wuA2 = 4*(wx02^3 + wA2*wx02 + wB2) +NAw = lambda dv: (wx02 + dv)*dv^2 + wvA2*dv + wuA2 +d3w = wu2^2 - 2*wd2 - 3*wx02 +FinalPolyT = NAw(d3w)*wk2^2*wd2^2 - (wt2^2*wd2^2 - 2*NAw(wd2)*wk2^2)*d3w^2 +DeltaT = 4*FinalPolyT - GT +CkT = DeltaT.coefficient({wk2: 2, wt2: 0}) +CtT = DeltaT.coefficient({wk2: 0, wt2: 2}) +assert DeltaT == CkT*wk2^2 + CtT*wt2^2 +assert CtT == 0, "the t^2 correction no longer vanishes" +toV2b = Wt.hom(list(V2.gens()) + [V2.zero(), V2.zero()], V2) +CkV = toV2b(CkT) + +tsupport_docs = { + "tangent_psi3_bridge": """\ +/-- The certificate's `hp` input for the doubling case: modulo the tangent-line +curve membership and the tangency relation, the polynomial that +`tangent_x_certificate` takes as `hp` vanishes. No saturation factor is needed: +the tangency relation is linear in `A`, so the elimination is clean. -/""", + "tangent_k_semantics": """\ +/-- The meaning of the `k` atom: `2·y·ynum·d`, written with the true curve +coefficients, agrees with the certificate's polynomial. -/""", + "tangent_t_semantics": """\ +/-- The meaning of the `t` atom: `3·xnum² + A'·d⁴` —the numerator parts of the +codomain doubling slope— written with the true curve coefficients, agrees with +the certificate's polynomial. -/""", + "tangent_correction": """\ +/-- The correction closing the doubling wrapper's final step: the slope-free +cleared form of the target differs from the certificate's goal by `C · k²` for +the polynomial `C` here (the `t²` gap vanishes identically, asserted by the +generator), and `C` vanishes modulo the same relations. -/""", +} +thyp_lines = { + "hT1": " (hT1 : (" + lw(RT1_p, 12) + ") = 0)", + "hT2": " (hT2 : (" + lw(RT2_p, 12) + ") = 0)", + "hpsi": " (hpsi : 3*x0^4 + 6*A*x0^2 + 12*B*x0 - A^2 = 0)", +} +tsupport_parts = [] +for name, lhs_poly, rhs_poly in [ + ("tangent_psi3_bridge", hpT, None), + ("tangent_k_semantics", K_real, K1T), + ("tangent_t_semantics", T_real, T1T), + ("tangent_correction", CkV, None)]: + T0 = lhs_poly - (rhs_poly if rhs_poly is not None else 0) + lift = T0.lift(V2.ideal(tgens2)) + assert sum(c*g for c, g in zip(lift, tgens2)) == T0 + dens = [lcm([q.denominator() for q in c.coefficients()]) for c in lift if c != 0] + for dnm in dens: + assert dnm == 2^(dnm.valuation(2)), (name, dnm) + dj = max([0] + [dnm.valuation(2) for dnm in dens]) + lift = [2^dj * c for c in lift] + assert sum(c*g for c, g in zip(lift, tgens2)) == 2^dj * T0 + assert all(all(q in ZZ for q in c.coefficients()) for c in lift) + mass = sum(len(c.monomials())*len(g.monomials()) for c, g in zip(lift, tgens2)) + print(name, ": cofactors", [len(c.monomials()) for c in lift], "; mass", mass) + used = [(nm, c) for nm, c in zip(tnames2, lift) if c != 0] + combo = "\n + ".join("(" + lw(c, 8) + ") * " + nm for nm, c in used) + p2t = "" if dj == 0 else "(2 : F)^" + str(dj) + " * " + if rhs_poly is None: + goal = p2t + "(" + lw(lhs_poly, 6) + ")\n = 0" + else: + goal = (p2t + "(" + lw(lhs_poly, 6) + ")\n = " + + p2t + "(" + lw(rhs_poly, 8) + ")") + tsupport_parts.append(support_tmpl.format( + name=name, doc=tsupport_docs[name], vars="(d u v' x0 A B : F)", + binders="\n".join(thyp_lines[nm] for nm, _ in used), + goal=goal, combo=combo)) + +tsupport = "\n\n".join(tsupport_parts) + +text = chord + "\n\n" + support + "\n\n" + tang + "\n\n" + tsupport + "\n" +# The Sage ring names `mp` and `vp` stand for the primed intercepts; rename to the +# Lean identifiers m' and v' (whole words only). +text = re.sub(r"\bmp\b", "m'", text) +text = re.sub(r"\bvp\b", "v'", text) + + +def indent(s_): + return len(s_) - len(s_.lstrip()) + + +flat = text.split("\n") +in_comment = False +for i, line in enumerate(flat): + stripped = line.strip() + if in_comment: + if stripped.endswith("-/"): + in_comment = False + continue + if stripped.startswith("/--") or stripped.startswith("/-!"): + if not stripped.endswith("-/"): + in_comment = True + continue + if stripped == "by" or stripped.endswith(" by"): + nxt = next((l2 for l2 in flat[i+1:] if l2.strip()), "") + assert indent(nxt) > indent(line), (i + 1, line[:40], nxt[:40]) +print("layout lint clean") + +module_path = "CompElliptic/Isogenies/VeluCertificates.lean" +marker = "-- The declarations below are generated by `scripts/gen_velu_certificates.sage`;" +src = open(module_path).read() +assert marker in src, "marker line not found in " + module_path +head = src[:src.index(marker)] +out = (head + marker + "\n" + + "-- edit and re-run that script rather than editing them here.\n\n" + + text + "\nend CompElliptic.Isogenies\n") +with open(module_path, "w") as f: + f.write(out) +print("regenerated " + module_path) diff --git a/scripts/nanoda-config.json b/scripts/nanoda-config.json index 53b1015..4e23f52 100644 --- a/scripts/nanoda-config.json +++ b/scripts/nanoda-config.json @@ -14,7 +14,9 @@ "CompElliptic.Fields.Pasta.vestaBase._native.native_decide.ax_1", "CompElliptic.Fields.Pasta.vestaBase._native.native_decide.ax_2", "CompElliptic.Curves.Pasta.Pallas.q_nsmul_Gpt._native.native_decide.ax_1_1", - "CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt._native.native_decide.ax_1_1" + "CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt._native.native_decide.ax_1_1", + "CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt._native.native_decide.ax_1_1", + "CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt._native.native_decide.ax_1_1" ], "unpermitted_axiom_hard_error": true, "num_threads": 4, @@ -26,7 +28,9 @@ "CompElliptic.Fields.Pasta.vestaBase._native.native_decide.ax_1", "CompElliptic.Fields.Pasta.vestaBase._native.native_decide.ax_2", "CompElliptic.Curves.Pasta.Pallas.q_nsmul_Gpt._native.native_decide.ax_1_1", - "CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt._native.native_decide.ax_1_1" + "CompElliptic.Curves.Pasta.Pallas.q_nsmul_isoGpt._native.native_decide.ax_1_1", + "CompElliptic.Curves.Pasta.Vesta.p_nsmul_Gpt._native.native_decide.ax_1_1", + "CompElliptic.Curves.Pasta.Vesta.p_nsmul_isoGpt._native.native_decide.ax_1_1" ], "unknown_pp_declar_hard_error": true, "pp_to_stdout": true,