diff --git a/src/Core/CayleyDickson.fs b/src/Core/CayleyDickson.fs new file mode 100644 index 0000000000..681732092f --- /dev/null +++ b/src/Core/CayleyDickson.fs @@ -0,0 +1,133 @@ +namespace Zeta.Core + +/// Cayley–Dickson doubling — the structural primitive underlying the +/// "imaginary stack" design captured in the B-0623 trajectory. Given any +/// algebra `A` with addition, negation, +/// multiplication, and conjugation, the doubled algebra `Doubled<'A>` +/// consists of pairs `(a, b)` with +/// +/// (a, b) + (c, d) = (a + c, b + d) +/// (a, b) · (c, d) = (a · c − d̄ · b, d · a + b · c̄) +/// conj (a, b) = (conj a, −b) +/// +/// Applied iteratively: +/// +/// ℝ → ℂ — Real → Complex; loses total ordering +/// ℂ → ℍ — Complex → Quaternion; loses commutativity +/// ℍ → 𝕆 — Quaternion → Octonion; loses associativity +/// 𝕆 → 𝕊 — Octonion → Sedenion; loses alternativity + division algebra +/// +/// This is the substrate B-0623 names as the carrier of the "imaginary +/// direction" in the cognitive boot sequence; Adinkras (B-0623 follow-up +/// PRs) decorate this structure with colored-edge ECC information. The +/// doubling primitive is the load-bearing object; specific levels +/// (Complex, Quaternion, Octonion) are derived type aliases. +/// +/// Implementation note: operations on `'A` are supplied via the +/// `IAlgebra<'A>` dictionary rather than F# statically-resolved type +/// parameters. The dictionary form makes the lift `IAlgebra<'A> → +/// IAlgebra>` directly expressible (the structural fact +/// that motivates this module). SRTPs would require duplicated +/// per-arity inline functions and lose the explicit "I doubled the +/// algebra" surface that's the entire point. +type Doubled<'A> = { Real: 'A; Imag: 'A } + +/// Algebra operations required for Cayley–Dickson doubling. A type +/// `'A` qualifies as a (suitably-structured) algebra by providing +/// zero, addition, negation, multiplication, and conjugation. The +/// conjugation operation is the involutive antihomomorphism that +/// makes the doubling well-defined — for ℝ it's the identity; for ℂ +/// it's the standard complex conjugate; for ℍ and beyond it's defined +/// recursively by the doubling formula above. +type IAlgebra<'A> = + abstract Zero : 'A + abstract Add : 'A * 'A -> 'A + abstract Negate : 'A -> 'A + abstract Mul : 'A * 'A -> 'A + abstract Conj : 'A -> 'A + +[] +module Doubled = + + /// Construct a doubled element from its real and imaginary parts. + let make (real: 'A) (imag: 'A) : Doubled<'A> = { Real = real; Imag = imag } + + /// Lift an algebra on `'A` to an algebra on `Doubled<'A>`. + /// This IS the Cayley–Dickson construction; everything else + /// in this module is bookkeeping. + let algebra (inner: IAlgebra<'A>) : IAlgebra> = + { new IAlgebra> with + member _.Zero = + { Real = inner.Zero; Imag = inner.Zero } + + member _.Add(x, y) = + { Real = inner.Add(x.Real, y.Real) + Imag = inner.Add(x.Imag, y.Imag) } + + member _.Negate x = + { Real = inner.Negate x.Real + Imag = inner.Negate x.Imag } + + // (a, b) · (c, d) = (a·c − d̄·b, d·a + b·c̄) + member _.Mul(x, y) = + let realPart = + inner.Add( + inner.Mul(x.Real, y.Real), + inner.Negate(inner.Mul(inner.Conj y.Imag, x.Imag)) + ) + let imagPart = + inner.Add( + inner.Mul(y.Imag, x.Real), + inner.Mul(x.Imag, inner.Conj y.Real) + ) + { Real = realPart; Imag = imagPart } + + // conj (a, b) = (conj a, −b) + member _.Conj x = + { Real = inner.Conj x.Real + Imag = inner.Negate x.Imag } } + + +/// Base case of the imaginary stack: real numbers as a degenerate +/// algebra over themselves. Conjugation is the identity because ℝ +/// has no imaginary part. Using `float` rather than an exact rational +/// type intentionally — the stack is about structural properties of +/// the doubling, not numerical precision; exact-arithmetic variants +/// can be derived later by providing an `IAlgebra` instead. +[] +module Real = + + let algebra : IAlgebra = + { new IAlgebra with + member _.Zero = 0.0 + member _.Add(x, y) = x + y + member _.Negate x = -x + member _.Mul(x, y) = x * y + // ℝ-conjugation is identity (no imaginary part to flip). + member _.Conj x = x } + + +/// Type aliases for the first few levels of the imaginary stack. +/// `Complex` = ℝ doubled once; `Quaternion` = ℂ doubled; `Octonion` = +/// ℍ doubled; `Sedenion` = 𝕆 doubled. The naming makes the imaginary +/// stack's stratification readable at the type level, matching the +/// trajectory requirement that category-theory structure remain visible +/// in public type shapes. +type Complex = Doubled +type Quaternion = Doubled +type Octonion = Doubled +type Sedenion = Doubled + + +/// Pre-computed algebra instances at each level of the imaginary +/// stack. Constructing these once and reusing them is correct because +/// `IAlgebra<'A>` carries no state — it's a pure dictionary of +/// operations. The instances are the structural fact "ℝ → ℂ → ℍ → 𝕆 +/// is the imaginary stack" made concrete. +[] +module ImaginaryStack = + + let complex : IAlgebra = Doubled.algebra Real.algebra + let quaternion : IAlgebra = Doubled.algebra complex + let octonion : IAlgebra = Doubled.algebra quaternion + let sedenion : IAlgebra = Doubled.algebra octonion diff --git a/src/Core/Core.fsproj b/src/Core/Core.fsproj index d5c03706a8..3d15102ba6 100644 --- a/src/Core/Core.fsproj +++ b/src/Core/Core.fsproj @@ -13,6 +13,7 @@ + diff --git a/tests/Tests.FSharp/Algebra/CayleyDickson.Tests.fs b/tests/Tests.FSharp/Algebra/CayleyDickson.Tests.fs new file mode 100644 index 0000000000..98a6a409de --- /dev/null +++ b/tests/Tests.FSharp/Algebra/CayleyDickson.Tests.fs @@ -0,0 +1,198 @@ +module Zeta.Tests.Algebra.CayleyDicksonTests +#nowarn "0893" + +/// Tests for `CayleyDickson` — the structural primitive underlying +/// the imaginary stack (B-0623 PR1). Property structure mirrors the +/// classical Cayley-Dickson loss pattern: each doubling step should +/// preserve some algebraic invariants and lose specific others. +/// +/// ℝ → ℂ — addition stays Abelian; conjugation becomes +/// non-trivial; ordering is no longer total (we +/// don't test ordering loss since we never asserted +/// ordering at the ℝ level). +/// ℂ → ℍ — multiplication remains associative; loses +/// commutativity (i*j ≠ j*i). +/// ℍ → 𝕆 — loses associativity; we exhibit a specific +/// triple (a, b, c) with (a·b)·c ≠ a·(b·c). +/// +/// The shipping property "addition is associative + commutative at +/// every level" is verified at ℂ, ℍ, 𝕆 since it should NEVER break. + +open FsUnit.Xunit +open global.Xunit +open Zeta.Core + + +// ─── Helpers ────────────────────────────────────────────────────────── + +/// Approximate equality for floats — Cayley-Dickson at the float +/// level inherits all the IEEE 754 quirks; tests use this threshold +/// to keep them stable across platforms. +let private approxEq (a: float) (b: float) = + abs (a - b) < 1e-9 + +let private complexApproxEq (a: Complex) (b: Complex) = + approxEq a.Real b.Real && approxEq a.Imag b.Imag + +let private quaternionApproxEq (a: Quaternion) (b: Quaternion) = + complexApproxEq a.Real b.Real && complexApproxEq a.Imag b.Imag + +let private octonionApproxEq (a: Octonion) (b: Octonion) = + quaternionApproxEq a.Real b.Real && quaternionApproxEq a.Imag b.Imag + + +// ─── Complex (ℂ) ────────────────────────────────────────────────────── +// The first doubling. i² = −1 is the defining relation. + +[] +let ``Complex: i squared equals negative one`` () = + let alg = ImaginaryStack.complex + let i : Complex = Doubled.make 0.0 1.0 + let result = alg.Mul(i, i) + let expected = Doubled.make -1.0 0.0 + complexApproxEq result expected |> should be True + + +[] +let ``Complex: addition is commutative`` () = + let alg = ImaginaryStack.complex + let a = Doubled.make 3.0 4.0 + let b = Doubled.make -1.0 2.5 + complexApproxEq (alg.Add(a, b)) (alg.Add(b, a)) |> should be True + + +[] +let ``Complex: multiplication is commutative`` () = + // ℂ retains commutativity; it's quaternions that lose it. + let alg = ImaginaryStack.complex + let a = Doubled.make 1.5 -2.0 + let b = Doubled.make 3.0 0.5 + complexApproxEq (alg.Mul(a, b)) (alg.Mul(b, a)) |> should be True + + +[] +let ``Complex: conjugation flips sign of imaginary part`` () = + let alg = ImaginaryStack.complex + let z = Doubled.make 2.0 -3.5 + let conjZ = alg.Conj z + conjZ.Real |> should equal 2.0 + conjZ.Imag |> should equal 3.5 + + +// ─── Quaternion (ℍ) ──────────────────────────────────────────────────── +// Second doubling. Loses commutativity but stays associative. + +[] +let ``Quaternion: i squared equals negative one`` () = + let alg = ImaginaryStack.quaternion + let zeroC : Complex = Doubled.make 0.0 0.0 + let i : Quaternion = Doubled.make (Doubled.make 0.0 1.0) zeroC + let result = alg.Mul(i, i) + let expectedReal : Complex = Doubled.make -1.0 0.0 + complexApproxEq result.Real expectedReal |> should be True + complexApproxEq result.Imag zeroC |> should be True + + +[] +let ``Quaternion: multiplication loses commutativity (i*j != j*i)`` () = + let alg = ImaginaryStack.quaternion + // i = (i, 0) where the inner i is ℂ's i = (0, 1) + // j = (0, 1) where 1 is ℂ's (1, 0) and the embedding lifts it to imag + let zeroC : Complex = Doubled.make 0.0 0.0 + let oneC : Complex = Doubled.make 1.0 0.0 + let i : Quaternion = Doubled.make (Doubled.make 0.0 1.0) zeroC + let j : Quaternion = Doubled.make zeroC oneC + let ij = alg.Mul(i, j) + let ji = alg.Mul(j, i) + // In ℍ, ij = k and ji = −k, so ij ≠ ji. + quaternionApproxEq ij ji |> should be False + + +[] +let ``Quaternion: multiplication is still associative`` () = + let alg = ImaginaryStack.quaternion + // Pick three non-trivial quaternions; verify (a·b)·c = a·(b·c). + let a : Quaternion = Doubled.make (Doubled.make 1.0 2.0) (Doubled.make 3.0 4.0) + let b : Quaternion = Doubled.make (Doubled.make 5.0 6.0) (Doubled.make 7.0 8.0) + let c : Quaternion = Doubled.make (Doubled.make 9.0 0.5) (Doubled.make -1.0 2.5) + let ab_c = alg.Mul(alg.Mul(a, b), c) + let a_bc = alg.Mul(a, alg.Mul(b, c)) + quaternionApproxEq ab_c a_bc |> should be True + + +[] +let ``Quaternion: addition stays commutative across the lift`` () = + let alg = ImaginaryStack.quaternion + let a : Quaternion = Doubled.make (Doubled.make 1.0 2.0) (Doubled.make 3.0 4.0) + let b : Quaternion = Doubled.make (Doubled.make -1.5 0.5) (Doubled.make 2.5 -3.5) + quaternionApproxEq (alg.Add(a, b)) (alg.Add(b, a)) |> should be True + + +// ─── Octonion (𝕆) ────────────────────────────────────────────────────── +// Third doubling. Loses associativity. Addition + commutativity-of-addition +// still hold; multiplication is non-commutative AND non-associative. + +[] +let ``Octonion: addition stays commutative`` () = + let alg = ImaginaryStack.octonion + let mk a b c d e f g h : Octonion = + Doubled.make + (Doubled.make (Doubled.make a b) (Doubled.make c d)) + (Doubled.make (Doubled.make e f) (Doubled.make g h)) + let a = mk 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 + let b = mk -1.5 0.5 2.5 -3.5 0.25 -0.75 1.25 -2.25 + octonionApproxEq (alg.Add(a, b)) (alg.Add(b, a)) |> should be True + + +[] +let ``Octonion: exhibits non-associativity for a specific triple`` () = + // Famous example: take three orthogonal imaginary units in 𝕆 that + // form an "associative triple" in ℍ but NOT in 𝕆. Here we use a + // simpler approach — pick three octonions and show (a·b)·c ≠ a·(b·c) + // numerically. The doubling formula guarantees this happens for + // generic non-trivial elements; we don't need to construct the + // textbook example. + let alg = ImaginaryStack.octonion + let mk a b c d e f g h : Octonion = + Doubled.make + (Doubled.make (Doubled.make a b) (Doubled.make c d)) + (Doubled.make (Doubled.make e f) (Doubled.make g h)) + let a = mk 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 // e_0 + e_5 + let b = mk 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0 // e_2 + e_7 + let c = mk 0.0 1.0 0.0 0.0 0.0 0.0 1.0 0.0 // e_1 + e_6 + let ab_c = alg.Mul(alg.Mul(a, b), c) + let a_bc = alg.Mul(a, alg.Mul(b, c)) + octonionApproxEq ab_c a_bc |> should be False + + +// ─── Structural / Zero / Identity ────────────────────────────────────── +// Zero is the additive identity at every level; verify the lift +// preserves this property. + +[] +let ``Zero is additive identity at every level`` () = + let c = ImaginaryStack.complex + let q = ImaginaryStack.quaternion + let o = ImaginaryStack.octonion + let cZero = c.Zero + let qZero = q.Zero + let oZero = o.Zero + let cVal = Doubled.make 3.0 -4.0 + let qVal = Doubled.make cVal cZero + let oVal = Doubled.make qVal qZero + complexApproxEq (c.Add(cVal, cZero)) cVal |> should be True + quaternionApproxEq (q.Add(qVal, qZero)) qVal |> should be True + octonionApproxEq (o.Add(oVal, oZero)) oVal |> should be True + + +[] +let ``Negation is additive inverse at every level`` () = + let c = ImaginaryStack.complex + let q = ImaginaryStack.quaternion + let o = ImaginaryStack.octonion + let cVal = Doubled.make 1.5 -2.5 + let qVal = Doubled.make cVal (Doubled.make 0.5 0.25) + let oVal = Doubled.make qVal (Doubled.make (Doubled.make 1.0 1.0) (Doubled.make 1.0 1.0)) + complexApproxEq (c.Add(cVal, c.Negate cVal)) c.Zero |> should be True + quaternionApproxEq (q.Add(qVal, q.Negate qVal)) q.Zero |> should be True + octonionApproxEq (o.Add(oVal, o.Negate oVal)) o.Zero |> should be True diff --git a/tests/Tests.FSharp/Tests.FSharp.fsproj b/tests/Tests.FSharp/Tests.FSharp.fsproj index 769209a75c..8dc68848fb 100644 --- a/tests/Tests.FSharp/Tests.FSharp.fsproj +++ b/tests/Tests.FSharp/Tests.FSharp.fsproj @@ -15,6 +15,7 @@ +