cl3 1.0.0.4 → 2.0.0.0
raw patch · 7 files changed
+2920/−2146 lines, 7 filesdep +deepseqdep −QuickCheckPVP ok
version bump matches the API change (PVP)
Dependencies added: deepseq
Dependencies removed: QuickCheck
API changes (from Hackage documentation)
+ Algebra.Geometric.Cl3: instance Control.DeepSeq.NFData Algebra.Geometric.Cl3.Cl3
+ Algebra.Geometric.Cl3: mIx :: Cl3 -> Cl3
+ Algebra.Geometric.Cl3: randUnitary :: RandomGen g => g -> (Cl3, g)
+ Algebra.Geometric.Cl3: timesI :: Cl3 -> Cl3
Files
- ChangeLog.md +102/−0
- benchmarks/NbodyGameCl3.hs +7/−0
- cl3.cabal +34/−8
- src/Algebra/Geometric/Cl3.hs +2557/−1890
- src/Algebra/Geometric/Cl3/JonesCalculus.hs +17/−2
- stack.yaml +1/−1
- tests/TestCl3.hs +202/−245
ChangeLog.md view
@@ -1,5 +1,107 @@ # Revision history for cl3 +## 2.0.0.0 -- 2020-06-20++* Added work around for GHC 8.10 regression of Issue #15304 reproducing code changes from GHC MR 2608 in the source files+* Added 'BangPatterns' language extension+* Added 'MultiWayIf' language extension+* Added 'Control.DeepSeq' dependency for 'NFData' and 'rnf'+* Added class instance for 'NFData'+* Added 'randUnitary' for a random Unitary value in APS+* Added CPP flags to Cl3 be able to turn off derived instances and the random dependancy+* Added CPP flags to JonesCalculus to turn off the random dependancy+* Added new function 'mIx' for the Inverse Hodge Star operator+* Added new function 'timesI' to easily multiply 'i' times something +* Fixed 'compare' so that there will be a total order when comparing I with other I values+* Refactored 'compare' so that lets were moved to a higher level+* Refactored 'abs' so that (2*) was changed to (x + x) and common computations were let floated+* Refactored 'abs' to reduce duplicate code with a helper function+* Refactored 'signum' to inline more Double precesion math into the returned value+* Refactored 'signum' to reduce duplicate code with a helper function+* Added 'reimMag' helper function for calculating the magnitude of the real and imaginary grades of APS+* Refactored 'recip' to use a helper function, moved some shared calculations to a 'let' binding+* Removed the final 'reduce' from the Fractional instances+* Refactored 'log' to convert the 'sqrt' from inside the log to a '(/2)'+* Refactored imaginary implementation of 'log' to specialize the values at +/- 1 to be purly imaginary+* Refactored imaginary implementation of 'sqrt' to inline more Double precision math into the 'C' constructor+* Refactored imaginary implementation of 'sqrt' to specialize the values at 0 to be purly real+* Refactored complex implementation of 'sqrt' to inline more Double precision math into the 'C' constructor+* Refactored imaginary implementation of 'sin' to specialize the values at 0 to be purly real+* Refactored complex implementation of 'tan' to inline more Double precision math into the 'C' constructor+* Refactored imaginary implementation of 'tan' to specialize the value at 0 to be purly real+* Refactored real implementation of 'asin' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored imaginary implementation of 'asin' to specialize the value at 0 to be purly real+* Refactored complex implementation of 'asin' to inline more Double precision math into the 'C' constructor+* Refactored real implementation of 'acos' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored imaginary implementation of 'acos' to specialize the value at 0 to be purly real+* Refactored complex implementation of 'acos' to inline more Double precision math into the 'C' constructor+* Refactored complex implementation of 'acos' to specialize the value at 0 to be purly real+* Refactored imaginary implementation of 'atan' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored complex implementation of 'atan' to inline more Double precision math into the 'C' constructor+* Refactored complex implementation of 'tanh' to inline more Double precision math into the 'C' constructor+* Refactored imaginary implementation of 'asinh' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored complex implementation of 'asinh' to inline more Double precision math into the 'C' constructor+* Refactored real implementation of 'acosh' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored imaginary implementation of 'acosh' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored complex implementation of 'acosh' to inline more Double precision math into the 'C' constructor+* Refactored real implementation of 'atanh' to re-derive the implemenation to inline more Double precision math into the various constructors+* Refactored imaginary implementation of 'atanh' to inline more Double precision math into the 'I' constructor+* Refactored imaginary implementation of 'atanh' to specialize the value at 0 to be purly real+* Refactored complex implementation of 'atanh' to inline more Double precision math into the 'C' constructor+* Refactored 'lsv' same as 'abs'+* Refactored 'lsv' to guard the sqrt function so that negative values+* Refactored 'lsv' to use a helper function to reduce duplicated code+* Added 'loDisc' helper function to calculate lsv for PV and TPV+* Implemented hlint's suggestion to remove parens around pattern for 'spectraldcmp' helper function 'dcmp'+* Refactored 'dcmp' to order based on the RHS and to commonize the BPV and APS constructors+* Implemented hlint's suggestion to remove parens around pattern for 'eigvals' helper function 'eigv'+* Refactored 'eigv' to order based on the RHS and to commonize the BPV and APS constructors+* Added 'dup' helper function to duplicate a value in a tuple+* Implemented hlint's suggestion to remove parens around pattern for 'project' helper function 'proj'+* Refactored 'project' to use helper functions for single and double vector grade constructors+* Added 'biTriDProj' helper function for generating projectors for double vector grades+* Added 'triDProj' helper function for generating projectors for single vector grades+* Refactored 'boost2colinear' to specialize and inline more Double precision math+* Refactored 'isColinear' to be calculated with Double precision math with a helper function 'colinearHelper'+* Corrected 'isColinear' to properly test for colinear even with non-reduced values+* Added 'colinearHelper' function to calculate if the biparavector portion is colinear+* Refactored 'hasNilpotent' to be calculated with Double precision math with a helper function 'nilpotentHelper'+* Added 'nilpotentHelper' function to calculate if the biparavector portion is nilpotent+* Implemented hlint's suggestion to remove '$' from 'projEigs'+* Refactored 'reduce' to factor out a shared comparison and use a helper function+* Refactored 'reduce' to re-order some of the comparisons to ones that are more common+* Removed the old value of 'mI'+* Performed the multiplication that was in 'tol' and 'tol''+* Refactored 'recip'' to be in a point free style+* Refactored 'sqrt'' to be in a point free style+* Refactored 'tan'' to be in a point free style+* Refactored 'asin'' to be in a point free style+* Refactored 'acos'' to be in a point free style+* Refactored 'atan'' to be in a point free style+* Refactored 'tanh'' to be in a point free style+* Refactored 'asinh'' to be in a point free style+* Refactored 'atanh'' to be in a point free style+* Added random projectors, nilpotnents, and unitary cliffors, to the Random instance of Cl3+* Refactored 'rangePV' to be more uniform and within the required range+* Refactored 'rangeH' to be more uniform and within the required range+* Refactored 'rangeC' to be more uniform and within the required range+* Refactored 'rangeBPV' to be more uniform and within the required range+* Refactored 'rangeODD' to be more uniform and within the required range+* Refactored 'rangeTPV' to be more uniform and within the required range+* Refactored 'rangeAPS' to be more uniform and within the required range+* Refactored 'randUnitV3' to be more uniform and not to be biased to the poles+* Refactored 'randProjector' to inline more Double precision math into the PV constructor+* Refactored 'randNilpotent' to inline more Double precision math into the BPV constructor+* Added 'randUnitary' to generate random unitary Cliffors+* Refactored 'vectorHelper' to use 'randUnitV3'+* Rewrote the tests to use Criterion instead of QuickCheck+* Changed the tests Arbitrary to 'randomRIO'+* Changed the test's random input to be 5,000,000 Cliffors+* Refactored the tests to use 'mIx'+* Refactored the tests '≈≈' to be a mean squared error calculation compared to a threshold+* Refactored the tests 'poles' to use a 'closeTo' function instead of '≈≈' to compare with eigenvalues+* Added to the tests a 'closeTo' function to compare against eigenvalues in the complex plane using a Euclidean distance+ ## 1.0.0.4 -- 2018-10-18 * Found various improvements while preparing for NPFL specialized Jordan for BPV and APS
benchmarks/NbodyGameCl3.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ == 810+-- Work around to fix GHC Issue #15304, issue popped up again in GHC 8.10, it should be fixed in GHC 8.12+-- This code is meant to reproduce MR 2608 for GHC 8.10+{-# OPTIONS_GHC -funfolding-keeness-factor=1 -funfolding-use-threshold=80 #-}+#endif ------------------------------------------------------------------ -- |
cl3.cabal view
@@ -10,13 +10,13 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 1.0.0.4+version: 2.0.0.0 -- A short (one-line) description of the package. synopsis: Clifford Algebra of three dimensional space. -- A longer description of the package.-description: Haskell Library implementing standard functions for the Algebra of Physical Space Cl(3,0) +description: Haskell Library implementing standard functions for the Algebra of Physical Space Cl(3,0) -- URL for the project homepage or repository. homepage: https://github.com/waivio/cl3@@ -37,7 +37,7 @@ maintainer: Nathan Waivio <nathan.waivio@gmail.com> -- A copyright notice.-copyright: Copyright (C) 2017-2018 Nathan Waivio+copyright: Copyright (C) 2017-2020 Nathan Waivio category: Math, Algebra @@ -47,7 +47,10 @@ GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2,- GHC == 8.4.2+ GHC == 8.4.2,+ GHC == 8.4.4,+ GHC == 8.6.5,+ GHC == 8.8.3 -- Extra files to be distributed with the package, such as examples or a -- README.@@ -62,6 +65,16 @@ type: git location: https://github.com/waivio/cl3.git +flag do-no-derived-instances+ description: Disable derived instances to reduce noise when inspecting GHC Core+ manual: True+ default: False++flag do-no-random+ description: Build without random library support+ manual: True+ default: False+ library -- Modules exported by the library. exposed-modules:@@ -71,6 +84,12 @@ -- Compiler options ghc-options: -Wall -O2 + if flag(do-no-derived-instances)+ cpp-options: -DO_NO_DERIVED+ + if flag(do-no-random)+ cpp-options: -DO_NO_RANDOM+ -- LANGUAGE extensions used by modules in this package. other-extensions: Safe,@@ -78,20 +97,26 @@ ViewPatterns, DeriveDataTypeable, DeriveGeneric,- BangPatterns+ CPP,+ BangPatterns,+ MultiWayIf -- Other library packages from which modules are imported. build-depends: base >=4.7 && <5,- random >=1.0 && <2+ deepseq >=1.1 && <2 + if !flag(do-no-random)+ build-depends:+ random >=1.0 && <2+ -- Directories containing source files. hs-source-dirs: src -- Base language which the package is written in. default-language: Haskell2010 --- QuickCheck based test suite+-- Criterion based test suite test-suite test-cl3 type: exitcode-stdio-1.0 hs-source-dirs: tests@@ -100,7 +125,8 @@ build-depends: cl3, base >=4.7 && <5,- QuickCheck >=2.7 && <3+ criterion >=1.1 && <2,+ random >=1.0 && <2 default-language: Haskell2010 -- Criterion based benchmark
src/Algebra/Geometric/Cl3.hs view
@@ -4,1893 +4,2560 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}--------------------------------------------------------------------------------------------------- |--- Copyright : (C) 2018 Nathan Waivio--- License : BSD3--- Maintainer : Nathan Waivio <nathan.waivio@gmail.com>--- Stability : Stable--- Portability : unportable------ Library implementing standard functions for the <https://en.wikipedia.org/wiki/Algebra_of_physical_space Algebra of Physical Space> Cl(3,0)--- -------------------------------------------------------------------------------------------------module Algebra.Geometric.Cl3-(-- * The type for the Algebra of Physical Space- Cl3(..),- -- * Clifford Conjugate and Complex Conjugate- bar, dag,- -- * The littlest singular value- lsv,- -- * Constructor Selectors - For optimizing and simplifying calculations- toR, toV3, toBV, toI,- toPV, toH, toC,- toBPV, toODD, toTPV,- toAPS,- -- * Pretty Printing for use with Octave- showOctave,- -- * Eliminate grades that are less than 'tol' to use a simpler Constructor- reduce, tol,- -- * Random Instances- randR, rangeR,- randV3, rangeV3,- randBV, rangeBV,- randI, rangeI,- randPV, rangePV,- randH, rangeH,- randC, rangeC,- randBPV, rangeBPV,- randODD, rangeODD,- randTPV, rangeTPV,- randAPS, rangeAPS,- randUnitV3,- randProjector,- randNilpotent,- -- * Helpful Functions- eigvals, hasNilpotent,- spectraldcmp, project-) where---import Data.Data (Typeable, Data)-import GHC.Generics (Generic)-import Foreign.Storable (Storable, sizeOf, alignment, peek, poke)-import Foreign.Ptr (Ptr, plusPtr, castPtr)-import System.Random (RandomGen, Random, randomR, random)----- | Cl3 provides specialized constructors for sub-algebras and other geometric objects--- contained in the algebra. Cl(3,0), abbreviated to Cl3, is a Geometric Algebra--- of 3 dimensional space known as the Algebra of Physical Space (APS). Geometric Algebras are Real--- Clifford Algebras, double precision floats are used to approximate real numbers in this--- library. Single and Double grade combinations are specialized and live within the APS.------ * 'R' is the constructor for the Real Scalar Sub-algebra Grade-0------ * 'V3' is the Vector constructor Grade-1------ * 'BV' is the Bivector constructor Grade-2------ * 'I' is the Imaginary constructor Grade-3 and is the Pseudo-Scalar for APS------ * 'PV' is the Paravector constructor with Grade-0 and Grade-1 elements------ * 'H' is the Quaternion constructor it is the Even Sub-algebra with Grade-0 and Grade-2 elements------ * 'C' is the Complex constructor it is the Scalar Sub-algebra with Grade-0 and Grade-3 elements------ * 'BPV' is the Biparavector constructor with Grade-1 and Grade-2 elements------ * 'ODD' is the Odd constructor with Grade-1 and Grade-3 elements------ * 'TPV' is the Triparavector constructor with Grade-2 and Grade-3 elements------ * 'APS' is the constructor for an element in the Algebra of Physical Space with Grade-0 through Grade-3 elements----data Cl3 where- R :: !Double -> Cl3 -- Real Scalar Sub-algebra (G0)- V3 :: !Double -> !Double -> !Double -> Cl3 -- Vectors (G1)- BV :: !Double -> !Double -> !Double -> Cl3 -- Bivectors (G2)- I :: !Double -> Cl3 -- Trivector Imaginary Pseudo-Scalar (G3)- PV :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Paravector (G0 + G1)- H :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Quaternion Even Sub-algebra (G0 + G2)- C :: !Double -> !Double -> Cl3 -- Complex Sub-algebra (G0 + G3)- BPV :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3 -- Biparavector (G1 + G2)- ODD :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Odd (G1 + G3)- TPV :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Triparavector (G2 + G3)- APS :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3 -- Algebra of Physical Space (G0 + G1 + G2 + G3)- deriving (Show, Read, Typeable, Data, Generic)------ |'showOctave' for useful for debug purposes.--- The additional octave definition is needed: --- --- > e0 = [1,0;0,1]; e1=[0,1;1,0]; e2=[0,-i;i,0]; e3=[1,0;0,-1];------ This allows one to take advantage of the isomorphism between Cl3 and M(2,C)-showOctave :: Cl3 -> String-showOctave (R a0) = show a0 ++ "*e0"-showOctave (V3 a1 a2 a3) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3"-showOctave (BV a23 a31 a12) = show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"-showOctave (I a123) = show a123 ++ "i*e0"-showOctave (PV a0 a1 a2 a3) = show a0 ++ "*e0 + " ++ show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3"-showOctave (H a0 a23 a31 a12) = show a0 ++ "*e0 + " ++ show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"-showOctave (C a0 a123) = show a0 ++ "*e0 + " ++ show a123 ++ "i*e0"-showOctave (BPV a1 a2 a3 a23 a31 a12) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " ++- show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"-showOctave (ODD a1 a2 a3 a123) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " ++ show a123 ++ "i*e0"-showOctave (TPV a23 a31 a12 a123) = show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3 + " ++ show a123 ++ "i*e0"-showOctave (APS a0 a1 a2 a3 a23 a31 a12 a123) = show a0 ++ "*e0 + " ++ show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " ++- show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3 + " ++ show a123 ++ "i*e0"----- |Cl(3,0) has the property of equivalence. "Eq" is "True" when all of the grade elements are equivalent.-instance Eq Cl3 where- (R a0) == (R b0) = a0 == b0-- (R a0) == (V3 b1 b2 b3) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (R a0) == (BV b23 b31 b12) = a0 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (R a0) == (I b123) = a0 == 0 && b123 == 0- (R a0) == (PV b0 b1 b2 b3) = a0 == b0 && b1 == 0 && b2 == 0 && b3 == 0- (R a0) == (H b0 b23 b31 b12) = a0 == b0 && b23 == 0 && b31 == 0 && b12 == 0- (R a0) == (C b0 b123) = a0 == b0 && b123 == 0- (R a0) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (R a0) == (ODD b1 b2 b3 b123) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0- (R a0) == (TPV b23 b31 b12 b123) = a0 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0- (R a0) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0-- (V3 a1 a2 a3) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0- (BV a23 a31 a12) == (R b0) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0- (I a123) == (R b0) = a123 == 0 && b0 == 0- (PV a0 a1 a2 a3) == (R b0) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0- (H a0 a23 a31 a12) == (R b0) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0- (C a0 a123) == (R b0) = a0 == b0 && a123 == 0- (BPV a1 a2 a3 a23 a31 a12) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0- (ODD a1 a2 a3 a123) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b0 == 0- (TPV a23 a31 a12 a123) == (R b0) = a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0 && b0 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (R b0) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0-- (V3 a1 a2 a3) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3-- (V3 a1 a2 a3) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (V3 a1 a2 a3) == (I b123) = a1 == 0 && a2 == 0 && a3 == 0 && b123 == 0- (V3 a1 a2 a3) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && b0 == 0- (V3 a1 a2 a3) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (V3 a1 a2 a3) == (C b0 b123) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0 && b123 == 0- (V3 a1 a2 a3) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0- (V3 a1 a2 a3) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0- (V3 a1 a2 a3) == (TPV b23 b31 b12 b123) = a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0- (V3 a1 a2 a3) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0-- (BV a23 a31 a12) == (V3 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (I a123) == (V3 b1 b2 b3) = a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (PV a0 a1 a2 a3) == (V3 b1 b2 b3) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3- (H a0 a23 a31 a12) == (V3 b1 b2 b3) = a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (C a0 a123) == (V3 b1 b2 b3) = a0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (BPV a1 a2 a3 a23 a31 a12) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0- (ODD a1 a2 a3 a123) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0- (TPV a23 a31 a12 a123) == (V3 b1 b2 b3) = b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (V3 b1 b2 b3) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0-- (BV a23 a31 a12) == (BV b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12-- (BV a23 a31 a12) == (I b123) = a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0- (BV a23 a31 a12) == (PV b0 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (BV a23 a31 a12) == (H b0 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0- (BV a23 a31 a12) == (C b0 b123) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b123 == 0- (BV a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0- (BV a23 a31 a12) == (ODD b1 b2 b3 b123) = a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0- (BV a23 a31 a12) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0- (BV a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0-- (I a123) == (BV b23 b31 b12) = a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (PV a0 a1 a2 a3) == (BV b23 b31 b12) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (H a0 a23 a31 a12) == (BV b23 b31 b12) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12- (C a0 a123) == (BV b23 b31 b12) = a0 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (BPV a1 a2 a3 a23 a31 a12) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12- (ODD a1 a2 a3 a123) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (TPV a23 a31 a12 a123) == (BV b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (BV b23 b31 b12) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0-- (I a123) == (I b123) = a123 == b123-- (I a123) == (PV b0 b1 b2 b3) = a123 == 0 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (I a123) == (H b0 b23 b31 b12) = a123 == 0 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (I a123) == (C b0 b123) = a123 == b123 && b0 == 0- (I a123) == (BPV b1 b2 b3 b23 b31 b12) = a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (I a123) == (ODD b1 b2 b3 b123) = a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0- (I a123) == (TPV b23 b31 b12 b123) = a123 == b123 && b23 == 0 && b31 == 0 && b12 == 0- (I a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a123 == b123 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0-- (PV a0 a1 a2 a3) == (I b123) = b123 == 0 && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0- (H a0 a23 a31 a12) == (I b123) = b123 == 0 && a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0- (C a0 a123) == (I b123) = a123 == b123 && a0 == 0- (BPV a1 a2 a3 a23 a31 a12) == (I b123) = b123 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0- (ODD a1 a2 a3 a123) == (I b123) = a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0- (TPV a23 a31 a12 a123) == (I b123) = a123 == b123 && a23 == 0 && a31 == 0 && a12 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (I b123) = a123 == b123 && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0-- (PV a0 a1 a2 a3) == (PV b0 b1 b2 b3) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3-- (PV a0 a1 a2 a3) == (H b0 b23 b31 b12) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (PV a0 a1 a2 a3) == (C b0 b123) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && b123 == 0- (PV a0 a1 a2 a3) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0- (PV a0 a1 a2 a3) == (ODD b1 b2 b3 b123) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0- (PV a0 a1 a2 a3) == (TPV b23 b31 b12 b123) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0- (PV a0 a1 a2 a3) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0-- (H a0 a23 a31 a12) == (PV b0 b1 b2 b3) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (C a0 a123) == (PV b0 b1 b2 b3) = a0 == b0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (BPV a1 a2 a3 a23 a31 a12) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0- (ODD a1 a2 a3 a123) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0 && b0 == 0- (TPV a23 a31 a12 a123) == (PV b0 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (PV b0 b1 b2 b3) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0-- (H a0 a23 a31 a12) == (H b0 b23 b31 b12) = a0 == b0 && a23 == b23 && a31 == b31 && a12 == b12-- (H a0 a23 a31 a12) == (C b0 b123) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0- (H a0 a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0- (H a0 a23 a31 a12) == (ODD b1 b2 b3 b123) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0- (H a0 a23 a31 a12) == (TPV b23 b31 b12 b123) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0- (H a0 a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0-- (C a0 a123) == (H b0 b23 b31 b12) = a0 == b0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (BPV a1 a2 a3 a23 a31 a12) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0- (ODD a1 a2 a3 a123) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b0 == 0- (TPV a23 a31 a12 a123) == (H b0 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0 && a123 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (H b0 b23 b31 b12) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0-- (C a0 a123) == (C b0 b123) = a0 == b0 && a123 == b123-- (C a0 a123) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (C a0 a123) == (ODD b1 b2 b3 b123) = a0 == 0 && a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0- (C a0 a123) == (TPV b23 b31 b12 b123) = a0 == 0 && a123 == b123 && b23 == 0 && b31 == 0 && b12 == 0- (C a0 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0-- (BPV a1 a2 a3 a23 a31 a12) == (C b0 b123) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b123 == 0- (ODD a1 a2 a3 a123) == (C b0 b123) = b0 == 0 && a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0- (TPV a23 a31 a12 a123) == (C b0 b123) = b0 == 0 && a123 == b123 && a23 == 0 && a31 == 0 && a12 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (C b0 b123) = a0 == b0 && a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0-- (BPV a1 a2 a3 a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31 && a12 == b12-- (BPV a1 a2 a3 a23 a31 a12) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0 && a23 == 0 && a31 == 0 && a12 == 0- (BPV a1 a2 a3 a23 a31 a12) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0 && a1 == 0 && a2 == 0 && a3 == 0- (BPV a1 a2 a3 a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31 && a12 == b12- && b0 == 0 && b123 == 0-- (ODD a1 a2 a3 a123) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (TPV a23 a31 a12 a123) == (BPV b1 b2 b3 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31- && a12 == b12 && a123 == 0-- (ODD a1 a2 a3 a123) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123-- (ODD a1 a2 a3 a123) == (TPV b23 b31 b12 b123) = a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0- (ODD a1 a2 a3 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0-- (TPV a23 a31 a12 a123) == (ODD b1 b2 b3 b123) = a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123 && a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0-- (TPV a23 a31 a12 a123) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123-- (TPV a23 a31 a12 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123- && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0-- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123- && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0-- (APS a0 a1 a2 a3 a23 a31 a12 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23- && a31 == b31 && a12 == b12 && a123 == b123----- |Cl3 has a total preorder ordering in which all pairs are comparable by two real valued functions.--- Comparison of two reals is just the typical real compare function. When reals are compared to--- anything else it will compare the absolute value of the reals to the magnitude of the other cliffor.--- Compare of two complex values compares the polar magnitude of the complex numbers. Compare of --- two vectors compares the vector magnitudes. The Ord instance for the general case is based on --- the singular values of each cliffor and this Ordering compares the largest singular value 'abs' --- and then the littlest singular value 'lsv'. Some arbitrary cliffors may return EQ for Ord but not be --- exactly '==' equivalent, but they are related by a right and left multiplication of two unitary --- elements. For instance for the Cliffors A and B, A == B could be False, but compare A B is EQ, --- because A * V = U * B, where V and U are unitary. -instance Ord Cl3 where- compare (R a0) (R b0) = compare a0 b0- compare cliffor1 cliffor2 =- let (R a0) = abs cliffor1- (R b0) = abs cliffor2- in case compare a0 b0 of- EQ -> let (R a0') = lsv cliffor1- (R b0') = lsv cliffor2- in compare a0' b0'- LT -> LT- GT -> GT----- |Cl3 has a "Num" instance. "Num" is addition, geometric product, negation, 'abs' the largest--- singular value, and 'signum' like a unit vector of sorts.--- -instance Num Cl3 where- -- | Cl3 can be added- (R a0) + (R b0) = R (a0 + b0)-- (R a0) + (V3 b1 b2 b3) = PV a0 b1 b2 b3- (R a0) + (BV b23 b31 b12) = H a0 b23 b31 b12- (R a0) + (I b123) = C a0 b123- (R a0) + (PV b0 b1 b2 b3) = PV (a0 + b0) b1 b2 b3- (R a0) + (H b0 b23 b31 b12) = H (a0 + b0) b23 b31 b12- (R a0) + (C b0 b123) = C (a0 + b0) b123- (R a0) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 b23 b31 b12 0- (R a0) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 0 0 0 b123- (R a0) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 b23 b31 b12 b123- (R a0) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 b23 b31 b12 b123-- (V3 a1 a2 a3) + (R b0) = PV b0 a1 a2 a3- (BV a23 a31 a12) + (R b0) = H b0 a23 a31 a12- (I a123) + (R b0) = C b0 a123- (PV a0 a1 a2 a3) + (R b0) = PV (a0 + b0) a1 a2 a3- (H a0 a23 a31 a12) + (R b0) = H (a0 + b0) a23 a31 a12- (C a0 a123) + (R b0) = C (a0 + b0) a123- (BPV a1 a2 a3 a23 a31 a12) + (R b0) = APS b0 a1 a2 a3 a23 a31 a12 0- (ODD a1 a2 a3 a123) + (R b0) = APS b0 a1 a2 a3 0 0 0 a123- (TPV a23 a31 a12 a123) + (R b0) = APS b0 0 0 0 a23 a31 a12 a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (R b0) = APS (a0 + b0) a1 a2 a3 a23 a31 a12 a123-- (V3 a1 a2 a3) + (V3 b1 b2 b3) = V3 (a1 + b1) (a2 + b2) (a3 + b3)-- (V3 a1 a2 a3) + (BV b23 b31 b12) = BPV a1 a2 a3 b23 b31 b12- (V3 a1 a2 a3) + (I b123) = ODD a1 a2 a3 b123- (V3 a1 a2 a3) + (PV b0 b1 b2 b3) = PV b0 (a1 + b1) (a2 + b2) (a3 + b3)- (V3 a1 a2 a3) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 b23 b31 b12 0- (V3 a1 a2 a3) + (C b0 b123) = APS b0 a1 a2 a3 0 0 0 b123- (V3 a1 a2 a3) + (BPV b1 b2 b3 b23 b31 b12) = BPV (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12- (V3 a1 a2 a3) + (ODD b1 b2 b3 b123) = ODD (a1 + b1) (a2 + b2) (a3 + b3) b123- (V3 a1 a2 a3) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 b23 b31 b12 b123- (V3 a1 a2 a3) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 b123-- (BV a23 a31 a12) + (V3 b1 b2 b3) = BPV b1 b2 b3 a23 a31 a12- (I a123) + (V3 b1 b2 b3) = ODD b1 b2 b3 a123- (PV a0 a1 a2 a3) + (V3 b1 b2 b3) = PV a0 (a1 + b1) (a2 + b2) (a3 + b3)- (H a0 a23 a31 a12) + (V3 b1 b2 b3) = APS a0 b1 b2 b3 a23 a31 a12 0- (C a0 a123) + (V3 b1 b2 b3) = APS a0 b1 b2 b3 0 0 0 a123- (BPV a1 a2 a3 a23 a31 a12) + (V3 b1 b2 b3) = BPV (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12- (ODD a1 a2 a3 a123) + (V3 b1 b2 b3) = ODD (a1 + b1) (a2 + b2) (a3 + b3) a123- (TPV a23 a31 a12 a123) + (V3 b1 b2 b3) = APS 0 b1 b2 b3 a23 a31 a12 a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (V3 b1 b2 b3) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 a123-- (BV a23 a31 a12) + (BV b23 b31 b12) = BV (a23 + b23) (a31 + b31) (a12 + b12)-- (BV a23 a31 a12) + (I b123) = TPV a23 a31 a12 b123- (BV a23 a31 a12) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 a23 a31 a12 0- (BV a23 a31 a12) + (H b0 b23 b31 b12) = H b0 (a23 + b23) (a31 + b31) (a12 + b12)- (BV a23 a31 a12) + (C b0 b123) = APS b0 0 0 0 a23 a31 a12 b123- (BV a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = BPV b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12)- (BV a23 a31 a12) + (ODD b1 b2 b3 b123) = APS 0 b1 b2 b3 a23 a31 a12 b123- (BV a23 a31 a12) + (TPV b23 b31 b12 b123) = TPV (a23 + b23) (a31 + b31) (a12 + b12) b123- (BV a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) b123-- (I a123) + (BV b23 b31 b12) = TPV b23 b31 b12 a123- (PV a0 a1 a2 a3) + (BV b23 b31 b12) = APS a0 a1 a2 a3 b23 b31 b12 0- (H a0 a23 a31 a12) + (BV b23 b31 b12) = H a0 (a23 + b23) (a31 + b31) (a12 + b12)- (C a0 a123) + (BV b23 b31 b12) = APS a0 0 0 0 b23 b31 b12 a123- (BPV a1 a2 a3 a23 a31 a12) + (BV b23 b31 b12) = BPV a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12)- (ODD a1 a2 a3 a123) + (BV b23 b31 b12) = APS 0 a1 a2 a3 b23 b31 b12 a123- (TPV a23 a31 a12 a123) + (BV b23 b31 b12) = TPV (a23 + b23) (a31 + b31) (a12 + b12) a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (BV b23 b31 b12) = APS a0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) a123-- (I a123) + (I b123) = I (a123 + b123)-- (I a123) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 0 0 0 a123- (I a123) + (H b0 b23 b31 b12) = APS b0 0 0 0 b23 b31 b12 a123- (I a123) + (C b0 b123) = C b0 (a123 + b123)- (I a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 b1 b2 b3 b23 b31 b12 a123- (I a123) + (ODD b1 b2 b3 b123) = ODD b1 b2 b3 (a123 + b123)- (I a123) + (TPV b23 b31 b12 b123) = TPV b23 b31 b12 (a123 + b123)- (I a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 b23 b31 b12 (a123 + b123)-- (PV a0 a1 a2 a3) + (I b123) = APS a0 a1 a2 a3 0 0 0 b123- (H a0 a23 a31 a12) + (I b123) = APS a0 0 0 0 a23 a31 a12 b123- (C a0 a123) + (I b123) = C a0 (a123 + b123)- (BPV a1 a2 a3 a23 a31 a12) + (I b123) = APS 0 a1 a2 a3 a23 a31 a12 b123- (ODD a1 a2 a3 a123) + (I b123) = ODD a1 a2 a3 (a123 + b123)- (TPV a23 a31 a12 a123) + (I b123) = TPV a23 a31 a12 (a123 + b123)- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (I b123) = APS a0 a1 a2 a3 a23 a31 a12 (a123 + b123)-- (PV a0 a1 a2 a3) + (PV b0 b1 b2 b3) = PV (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3)-- (PV a0 a1 a2 a3) + (H b0 b23 b31 b12) = APS (a0 + b0) a1 a2 a3 b23 b31 b12 0- (PV a0 a1 a2 a3) + (C b0 b123) = APS (a0 + b0) a1 a2 a3 0 0 0 b123- (PV a0 a1 a2 a3) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 0- (PV a0 a1 a2 a3) + (ODD b1 b2 b3 b123) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) 0 0 0 b123- (PV a0 a1 a2 a3) + (TPV b23 b31 b12 b123) = APS a0 a1 a2 a3 b23 b31 b12 b123- (PV a0 a1 a2 a3) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 b123-- (H a0 a23 a31 a12) + (PV b0 b1 b2 b3) = APS (a0 + b0) b1 b2 b3 a23 a31 a12 0- (C a0 a123) + (PV b0 b1 b2 b3) = APS (a0 + b0) b1 b2 b3 0 0 0 a123- (BPV a1 a2 a3 a23 a31 a12) + (PV b0 b1 b2 b3) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 0- (ODD a1 a2 a3 a123) + (PV b0 b1 b2 b3) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) 0 0 0 a123- (TPV a23 a31 a12 a123) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 a23 a31 a12 a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (PV b0 b1 b2 b3) = APS (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 a123-- (H a0 a23 a31 a12) + (H b0 b23 b31 b12) = H (a0 + b0) (a23 + b23) (a31 + b31) (a12 + b12)-- (H a0 a23 a31 a12) + (C b0 b123) = APS (a0 + b0) 0 0 0 a23 a31 a12 b123- (H a0 a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) 0- (H a0 a23 a31 a12) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 a23 a31 a12 b123- (H a0 a23 a31 a12) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 (a23 + b23) (a31 + b31) (a12 + b12) b123- (H a0 a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) b123-- (C a0 a123) + (H b0 b23 b31 b12) = APS (a0 + b0) 0 0 0 b23 b31 b12 a123- (BPV a1 a2 a3 a23 a31 a12) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) 0- (ODD a1 a2 a3 a123) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 b23 b31 b12 a123- (TPV a23 a31 a12 a123) + (H b0 b23 b31 b12) = APS b0 0 0 0 (a23 + b23) (a31 + b31) (a12 + b12) a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (H b0 b23 b31 b12) = APS (a0 + b0) a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) a123-- (C a0 a123) + (C b0 b123) = C (a0 + b0) (a123 + b123)-- (C a0 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 b23 b31 b12 a123- (C a0 a123) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 0 0 0 (a123 + b123)- (C a0 a123) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 b23 b31 b12 (a123 + b123)- (C a0 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 b23 b31 b12 (a123 + b123)-- (BPV a1 a2 a3 a23 a31 a12) + (C b0 b123) = APS b0 a1 a2 a3 a23 a31 a12 b123- (ODD a1 a2 a3 a123) + (C b0 b123) = APS b0 a1 a2 a3 0 0 0 (a123 + b123)- (TPV a23 a31 a12 a123) + (C b0 b123) = APS b0 0 0 0 a23 a31 a12 (a123 + b123)- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (C b0 b123) = APS (a0 + b0) a1 a2 a3 a23 a31 a12 (a123 + b123)-- (BPV a1 a2 a3 a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = BPV (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12)-- (BPV a1 a2 a3 a23 a31 a12) + (ODD b1 b2 b3 b123) = APS 0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 b123- (BPV a1 a2 a3 a23 a31 a12) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) b123- (BPV a1 a2 a3 a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12) b123-- (ODD a1 a2 a3 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 a123- (TPV a23 a31 a12 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) a123- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12) a123-- (ODD a1 a2 a3 a123) + (ODD b1 b2 b3 b123) = ODD (a1 + b1) (a2 + b2) (a3 + b3) (a123 + b123)-- (ODD a1 a2 a3 a123) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 b23 b31 b12 (a123 + b123)- (ODD a1 a2 a3 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 (a123 + b123)-- (TPV a23 a31 a12 a123) + (ODD b1 b2 b3 b123) = APS 0 b1 b2 b3 a23 a31 a12 (a123 + b123)- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (ODD b1 b2 b3 b123) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 (a123 + b123)-- (TPV a23 a31 a12 a123) + (TPV b23 b31 b12 b123) = TPV (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)-- (TPV a23 a31 a12 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)-- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (TPV b23 b31 b12 b123) = APS a0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)-- (APS a0 a1 a2 a3 a23 a31 a12 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0)- (a1 + b1) (a2 + b2) (a3 + b3)- (a23 + b23) (a31 + b31) (a12 + b12)- (a123 + b123)-- -- | Multiplication Instance implementing a Geometric Product- (R a0) * (R b0) = R (a0*b0)-- (R a0) * (V3 b1 b2 b3) = V3 (a0*b1) (a0*b2) (a0*b3)- (R a0) * (BV b23 b31 b12) = BV (a0*b23) (a0*b31) (a0*b12)- (R a0) * (I b123) = I (a0*b123)- (R a0) * (PV b0 b1 b2 b3) = PV (a0*b0)- (a0*b1) (a0*b2) (a0*b3)- (R a0) * (H b0 b23 b31 b12) = H (a0*b0)- (a0*b23) (a0*b31) (a0*b12)- (R a0) * (C b0 b123) = C (a0*b0)- (a0*b123)- (R a0) * (BPV b1 b2 b3 b23 b31 b12) = BPV (a0*b1) (a0*b2) (a0*b3)- (a0*b23) (a0*b31) (a0*b12)- (R a0) * (ODD b1 b2 b3 b123) = ODD (a0*b1) (a0*b2) (a0*b3)- (a0*b123)- (R a0) * (TPV b23 b31 b12 b123) = TPV (a0*b23) (a0*b31) (a0*b12)- (a0*b123)- (R a0) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0)- (a0*b1) (a0*b2) (a0*b3)- (a0*b23) (a0*b31) (a0*b12)- (a0*b123)-- (V3 a1 a2 a3) * (R b0) = V3 (a1*b0) (a2*b0) (a3*b0)- (BV a23 a31 a12) * (R b0) = BV (a23*b0) (a31*b0) (a12*b0)- (I a123) * (R b0) = I (a123*b0)- (PV a0 a1 a2 a3) * (R b0) = PV (a0*b0)- (a1*b0) (a2*b0) (a3*b0)- (H a0 a23 a31 a12) * (R b0) = H (a0*b0)- (a23*b0) (a31*b0) (a12*b0)- (C a0 a123) * (R b0) = C (a0*b0)- (a123*b0)- (BPV a1 a2 a3 a23 a31 a12) * (R b0) = BPV (a1*b0) (a2*b0) (a3*b0)- (a23*b0) (a31*b0) (a12*b0)- (ODD a1 a2 a3 a123) * (R b0) = ODD (a1*b0) (a2*b0) (a3*b0)- (a123*b0)- (TPV a23 a31 a12 a123) * (R b0) = TPV (a23*b0) (a31*b0) (a12*b0)- (a123*b0)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (R b0) = APS (a0*b0)- (a1*b0) (a2*b0) (a3*b0)- (a23*b0) (a31*b0) (a12*b0)- (a123*b0)-- (V3 a1 a2 a3) * (V3 b1 b2 b3) = H (a1*b1 + a2*b2 + a3*b3)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)-- (V3 a1 a2 a3) * (BV b23 b31 b12) = ODD (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)- (a1*b23 + a2*b31 + a3*b12)- (V3 a1 a2 a3) * (I b123) = BV (a1*b123) (a2*b123) (a3*b123)- (V3 a1 a2 a3) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a1*b0) (a2*b0) (a3*b0)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)- 0- (V3 a1 a2 a3) * (H b0 b23 b31 b12) = ODD (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)- (a1*b23 + a2*b31 + a3*b12)- (V3 a1 a2 a3) * (C b0 b123) = BPV (a1*b0) (a2*b0) (a3*b0)- (a1*b123) (a2*b123) (a3*b123)- (V3 a1 a2 a3) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)- (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)- (a1*b23 + a2*b31 + a3*b12)- (V3 a1 a2 a3) * (ODD b1 b2 b3 b123) = H (a1*b1 + a2*b2 + a3*b3)- (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)- (V3 a1 a2 a3) * (TPV b23 b31 b12 b123) = APS 0- (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)- (a1*b123) (a2*b123) (a3*b123)- (a1*b23 + a2*b31 + a3*b12)- (V3 a1 a2 a3) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3)- (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)- (a1*b123 + a2*b3 - a3*b2) (a3*b1 - a1*b3 + a2*b123) (a1*b2 - a2*b1 + a3*b123)- (a1*b23 + a2*b31 + a3*b12)-- (BV a23 a31 a12) * (V3 b1 b2 b3) = ODD (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)- (a23*b1 + a31*b2 + a12*b3)- (I a123) * (V3 b1 b2 b3) = BV (a123*b1) (a123*b2) (a123*b3)- (PV a0 a1 a2 a3) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a0*b1) (a0*b2) (a0*b3)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)- 0- (H a0 a23 a31 a12) * (V3 b1 b2 b3) = ODD (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)- (a23*b1 + a31*b2 + a12*b3)- (C a0 a123) * (V3 b1 b2 b3) = BPV (a0*b1) (a0*b2) (a0*b3)- (a123*b1) (a123*b2) (a123*b3)- (BPV a1 a2 a3 a23 a31 a12) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)- (a23*b1 + a31*b2 + a12*b3)- (ODD a1 a2 a3 a123) * (V3 b1 b2 b3) = H (a1*b1 + a2*b2 + a3*b3)- (a123*b1 + a2*b3 - a3*b2) (a123*b2 - a1*b3 + a3*b1) (a123*b3 + a1*b2 - a2*b1)- (TPV a23 a31 a12 a123) * (V3 b1 b2 b3) = APS 0- (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)- (a123*b1) (a123*b2) (a123*b3)- (a23*b1 + a31*b2 + a12*b3)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)- (a123*b1 + a2*b3 - a3*b2) (a3*b1 - a1*b3 + a123*b2) (a1*b2 - a2*b1 + a123*b3)- (a23*b1 + a31*b2 + a12*b3)-- (BV a23 a31 a12) * (BV b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)- (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)-- (BV a23 a31 a12) * (I b123) = V3 (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (BV a23 a31 a12) * (PV b0 b1 b2 b3) = APS 0- (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)- (a23*b0) (a31*b0) (a12*b0)- (a23*b1 + a31*b2 + a12*b3)- (BV a23 a31 a12) * (H b0 b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)- (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)- (BV a23 a31 a12) * (C b0 b123) = BPV (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a23*b0) (a31*b0) (a12*b0)- (BV a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2) - (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)- (a23*b1 + a31*b2 + a12*b3)- (BV a23 a31 a12) * (ODD b1 b2 b3 b123) = ODD (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)- (a23*b1 + a31*b2 + a12*b3)- (BV a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)- 0- (BV a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a31*b123 - a12*b1) (a31*b1 - a23*b2 - a12*b123)- (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)- (a23*b1 + a31*b2 + a12*b3)-- (I a123) * (BV b23 b31 b12) = V3 (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (PV a0 a1 a2 a3) * (BV b23 b31 b12) = APS 0- (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)- (a0*b23) (a0*b31) (a0*b12)- (a1*b23 + a2*b31 + a3*b12)- (H a0 a23 a31 a12) * (BV b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)- (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)- (C a0 a123) * (BV b23 b31 b12) = BPV (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a0*b23) (a0*b31) (a0*b12)- (BPV a1 a2 a3 a23 a31 a12) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31) - (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)- (a1*b23 + a2*b31 + a3*b12)- (ODD a1 a2 a3 a123) * (BV b23 b31 b12) = ODD (negate $ a123*b23 + a2*b12 - a3*b31)- (negate $ a123*b31 - a1*b12 + a3*b23)- (negate $ a123*b12 + a1*b31 - a2*b23)- (a1*b23 + a2*b31 + a3*b12)- (TPV a23 a31 a12 a123) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (negate $ a31*b12 - a12*b31) (negate $ a12*b23 - a23*b12) (negate $ a23*b31 - a31*b23)- 0- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12) - (a3*b31 - a123*b23 - a2*b12) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a123*b12 - a1*b31)- (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)- (a1*b23 + a2*b31 + a3*b12)-- (I a123) * (I b123) = R (negate $ a123*b123)-- (I a123) * (PV b0 b1 b2 b3) = TPV (a123*b1) (a123*b2) (a123*b3)- (a123*b0)- (I a123) * (H b0 b23 b31 b12) = ODD (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a123*b0)- (I a123) * (C b0 b123) = C (negate $ a123*b123)- (a123*b0)- (I a123) * (BPV b1 b2 b3 b23 b31 b12) = BPV (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a123*b1) (a123*b2) (a123*b3)- (I a123) * (ODD b1 b2 b3 b123) = H (negate $ a123*b123)- (a123*b1) (a123*b2) (a123*b3)- (I a123) * (TPV b23 b31 b12 b123) = PV (negate $ a123*b123)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (I a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a123*b123)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a123*b1) (a123*b2) (a123*b3)- (a123*b0)-- (PV a0 a1 a2 a3) * (I b123) = TPV (a1*b123) (a2*b123) (a3*b123)- (a0*b123)- (H a0 a23 a31 a12) * (I b123) = ODD (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a0*b123)- (C a0 a123) * (I b123) = C (negate $ a123*b123)- (a0*b123)- (BPV a1 a2 a3 a23 a31 a12) * (I b123) = BPV (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a1*b123) (a2*b123) (a3*b123)- (ODD a1 a2 a3 a123) * (I b123) = H (negate $ a123*b123)- (a1*b123) (a2*b123) (a3*b123)- (TPV a23 a31 a12 a123) * (I b123) = PV (negate $ a123*b123)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (I b123) = APS (negate $ a123*b123)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a1*b123) (a2*b123) (a3*b123)- (a0*b123)--- (PV a0 a1 a2 a3) * (PV b0 b1 b2 b3) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)- (a0*b1 + a1*b0) (a0*b2 + a2*b0) (a0*b3 + a3*b0)- (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)- 0-- (PV a0 a1 a2 a3) * (H b0 b23 b31 b12) = APS (a0*b0)- (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)- (a0*b23) (a0*b31) (a0*b12)- (a1*b23 + a2*b31 + a3*b12)- (PV a0 a1 a2 a3) * (C b0 b123) = APS (a0*b0)- (a1*b0) (a2*b0) (a3*b0)- (a1*b123) (a2*b123) (a3*b123)- (a0*b123)- (PV a0 a1 a2 a3) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)- (a0*b1 - a2*b12 + a3*b31) (a0*b2 + a1*b12 - a3*b23) (a0*b3 - a1*b31 + a2*b23)- (a0*b23 + a2*b3 - a3*b2) (a0*b31 - a1*b3 + a3*b1) (a0*b12 + a1*b2 - a2*b1)- (a1*b23 + a2*b31 + a3*b12)- (PV a0 a1 a2 a3) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3)- (a0*b1) (a0*b2) (a0*b3)- (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)- (a0*b123)- (PV a0 a1 a2 a3) * (TPV b23 b31 b12 b123) = APS 0- (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)- (a0*b23 + a1*b123) (a0*b31 + a2*b123) (a0*b12 + a3*b123)- (a0*b123 + a1*b23 + a2*b31 + a3*b12)- (PV a0 a1 a2 a3) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)- (a0*b1 + a1*b0 - a2*b12 + a3*b31)- (a0*b2 + a2*b0 + a1*b12 - a3*b23)- (a0*b3 + a3*b0 - a1*b31 + a2*b23)- (a0*b23 + a1*b123 + a2*b3 - a3*b2)- (a0*b31 - a1*b3 + a3*b1 + a2*b123)- (a0*b12 + a1*b2 - a2*b1 + a3*b123)- (a0*b123 + a1*b23 + a2*b31 + a3*b12)-- (H a0 a23 a31 a12) * (PV b0 b1 b2 b3) = APS (a0*b0)- (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)- (a23*b0) (a31*b0) (a12*b0)- (a23*b1 + a31*b2 + a12*b3)- (C a0 a123) * (PV b0 b1 b2 b3) = APS (a0*b0)- (a0*b1) (a0*b2) (a0*b3)- (a123*b1) (a123*b2) (a123*b3)- (a123*b0)- (BPV a1 a2 a3 a23 a31 a12) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a1*b0 + a12*b2 - a31*b3) (a2*b0 - a12*b1 + a23*b3) (a3*b0 + a31*b1 - a23*b2)- (a23*b0 + a2*b3 - a3*b2) (a31*b0 - a1*b3 + a3*b1) (a12*b0 + a1*b2 - a2*b1)- (a23*b1 + a31*b2 + a12*b3)- (ODD a1 a2 a3 a123) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)- (a1*b0) (a2*b0) (a3*b0)- (a123*b1 + a2*b3 - a3*b2)- (a123*b2 - a1*b3 + a3*b1)- (a123*b3 + a1*b2 - a2*b1)- (a123*b0)- (TPV a23 a31 a12 a123) * (PV b0 b1 b2 b3) = APS 0- (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)- (a23*b0 + a123*b1) (a31*b0 + a123*b2) (a12*b0 + a123*b3)- (a123*b0 + a23*b1 + a31*b2 + a12*b3)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (PV b0 b1 b2 b3) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)- (a0*b1 + a1*b0 + a12*b2 - a31*b3)- (a0*b2 + a2*b0 - a12*b1 + a23*b3)- (a0*b3 + a3*b0 + a31*b1 - a23*b2)- (a23*b0 + a123*b1 + a2*b3 - a3*b2)- (a31*b0 - a1*b3 + a3*b1 + a123*b2)- (a12*b0 + a1*b2 - a2*b1 + a123*b3)- (a123*b0 + a23*b1 + a31*b2 + a12*b3)-- (H a0 a23 a31 a12) * (H b0 b23 b31 b12) = H (a0*b0 - a23*b23 - a31*b31 - a12*b12)- (a0*b23 + a23*b0 - a31*b12 + a12*b31)- (a0*b31 + a31*b0 + a23*b12 - a12*b23)- (a0*b12 + a12*b0 - a23*b31 + a31*b23)-- (H a0 a23 a31 a12) * (C b0 b123) = APS (a0*b0)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a23*b0) (a31*b0) (a12*b0)- (a0*b123)- (H a0 a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)- (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)- (a23*b1 + a31*b2 + a12*b3)- (H a0 a23 a31 a12) * (ODD b1 b2 b3 b123) = ODD (a0*b1 + a12*b2 - a31*b3 - a23*b123)- (a0*b2 - a12*b1 + a23*b3 - a31*b123)- (a0*b3 + a31*b1 - a23*b2 - a12*b123)- (a0*b123 + a23*b1 + a31*b2 + a12*b3)- (H a0 a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)- (a0*b123)- (H a0 a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 - a23*b23 - a31*b31 - a12*b12)- (a0*b1 + a12*b2 - a31*b3 - a23*b123)- (a0*b2 - a12*b1 + a23*b3 - a31*b123)- (a0*b3 + a31*b1 - a23*b2 - a12*b123)- (a0*b23 + a23*b0 - a31*b12 + a12*b31)- (a0*b31 + a31*b0 + a23*b12 - a12*b23)- (a0*b12 + a12*b0 - a23*b31 + a31*b23)- (a0*b123 + a23*b1 + a31*b2 + a12*b3)-- (C a0 a123) * (H b0 b23 b31 b12) = APS (a0*b0)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a0*b23) (a0*b31) (a0*b12)- (a123*b0)- (BPV a1 a2 a3 a23 a31 a12) * (H b0 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)- (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)- (a1*b23 + a2*b31 + a3*b12)- (ODD a1 a2 a3 a123) * (H b0 b23 b31 b12) = ODD (a1*b0 - a2*b12 + a3*b31 - a123*b23)- (a2*b0 + a1*b12 - a3*b23 - a123*b31)- (a3*b0 - a1*b31 + a2*b23 - a123*b12)- (a123*b0 + a1*b23 + a2*b31 + a3*b12)- (TPV a23 a31 a12 a123) * (H b0 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)- (a123*b0)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (H b0 b23 b31 b12) = APS (a0*b0 - a23*b23 - a31*b31 - a12*b12)- (a1*b0 - a2*b12 + a3*b31 - a123*b23)- (a2*b0 + a1*b12 - a3*b23 - a123*b31)- (a3*b0 - a1*b31 + a2*b23 - a123*b12)- (a0*b23 + a23*b0 - a31*b12 + a12*b31)- (a0*b31 + a31*b0 + a23*b12 - a12*b23)- (a0*b12 + a12*b0 - a23*b31 + a31*b23)- (a123*b0 + a1*b23 + a2*b31 + a3*b12)-- (C a0 a123) * (C b0 b123) = C (a0*b0 - a123*b123)- (a0*b123 + a123*b0)-- (C a0 a123) * (BPV b1 b2 b3 b23 b31 b12) = BPV (a0*b1 - a123*b23) (a0*b2 - a123*b31) (a0*b3 - a123*b12)- (a0*b23 + a123*b1) (a0*b31 + a123*b2) (a0*b12 + a123*b3)- (C a0 a123) * (ODD b1 b2 b3 b123) = APS (negate $ a123*b123)- (a0*b1) (a0*b2) (a0*b3)- (a123*b1) (a123*b2) (a123*b3)- (a0*b123)- (C a0 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a123*b123)- (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)- (a0*b23) (a0*b31) (a0*b12)- (a0*b123)- (C a0 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 - a123*b123)- (a0*b1 - a123*b23) (a0*b2 - a123*b31) (a0*b3 - a123*b12)- (a0*b23 + a123*b1) (a0*b31 + a123*b2) (a0*b12 + a123*b3)- (a0*b123 + a123*b0)-- (BPV a1 a2 a3 a23 a31 a12) * (C b0 b123) = BPV (a1*b0 - a23*b123) (a2*b0 - a31*b123) (a3*b0 - a12*b123)- (a23*b0 + a1*b123) (a31*b0 + a2*b123) (a12*b0 + a3*b123)- (ODD a1 a2 a3 a123) * (C b0 b123) = APS (negate $ a123*b123)- (a1*b0) (a2*b0) (a3*b0)- (a1*b123) (a2*b123) (a3*b123)- (a123*b0)- (TPV a23 a31 a12 a123) * (C b0 b123) = APS (negate $ a123*b123)- (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)- (a23*b0) (a31*b0) (a12*b0)- (a123*b0)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (C b0 b123) = APS (a0*b0 - a123*b123)- (a1*b0 - a23*b123) (a2*b0 - a31*b123) (a3*b0 - a12*b123)- (a23*b0 + a1*b123) (a31*b0 + a2*b123) (a12*b0 + a3*b123)- (a0*b123 + a123*b0)-- (BPV a1 a2 a3 a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)- (a12*b2 - a2*b12 + a3*b31 - a31*b3)- (a1*b12 - a12*b1 - a3*b23 + a23*b3)- (a31*b1 - a1*b31 + a2*b23 - a23*b2)- (a2*b3 - a3*b2 - a31*b12 + a12*b31)- (a3*b1 - a1*b3 + a23*b12 - a12*b23)- (a1*b2 - a2*b1 - a23*b31 + a31*b23)- (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)-- (BPV a1 a2 a3 a23 a31 a12) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3)- (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)- (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)- (a23*b1 + a31*b2 + a12*b3)- (BPV a1 a2 a3 a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a3*b31 - a2*b12 - a23*b123) (a1*b12 - a3*b23 - a31*b123) (a2*b23 - a1*b31 - a12*b123)- (a1*b123 - a31*b12 + a12*b31) (a2*b123 + a23*b12 - a12*b23) (a3*b123 - a23*b31 + a31*b23)- (a1*b23 + a2*b31 + a3*b12)- (BPV a1 a2 a3 a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)- (a1*b0 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a23*b123)- (a2*b0 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a31*b123)- (a3*b0 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a12*b123)- (a23*b0 + a1*b123 + a2*b3 - a3*b2 - a31*b12 + a12*b31)- (a31*b0 - a1*b3 + a3*b1 + a2*b123 + a23*b12 - a12*b23)- (a12*b0 + a1*b2 - a2*b1 + a3*b123 - a23*b31 + a31*b23)- (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)-- (ODD a1 a2 a3 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)- (a3*b31 - a2*b12 - a123*b23) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a1*b31 - a123*b12)- (a123*b1 + a2*b3 - a3*b2) (a123*b2 - a1*b3 + a3*b1) (a123*b3 + a1*b2 - a2*b1)- (a1*b23 + a2*b31 + a3*b12)- (TPV a23 a31 a12 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)- (a12*b2 - a31*b3 - a123*b23) (a23*b3 - a12*b1 - a123*b31) (a31*b1 - a23*b2 - a123*b12)- (a123*b1 - a31*b12 + a12*b31) (a123*b2 + a23*b12 - a12*b23) (a123*b3 - a23*b31 + a31*b23)- (a23*b1 + a31*b2 + a12*b3)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)- (a0*b1 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a123*b23)- (a0*b2 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a123*b31)- (a0*b3 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a123*b12)- (a0*b23 + a123*b1 + a2*b3 - a3*b2 - a31*b12 + a12*b31)- (a0*b31 - a1*b3 + a3*b1 + a123*b2 + a23*b12 - a12*b23)- (a0*b12 + a1*b2 - a2*b1 + a123*b3 - a23*b31 + a31*b23)- (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)-- (ODD a1 a2 a3 a123) * (ODD b1 b2 b3 b123) = H (a1*b1 + a2*b2 + a3*b3 - a123*b123)- (a1*b123 + a123*b1 + a2*b3 - a3*b2)- (a2*b123 + a123*b2 - a1*b3 + a3*b1)- (a3*b123 + a123*b3 + a1*b2 - a2*b1)-- (ODD a1 a2 a3 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a123*b123)- (a3*b31 - a2*b12 - a123*b23) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a1*b31 - a123*b12)- (a1*b123) (a2*b123) (a3*b123)- (a1*b23 + a2*b31 + a3*b12)- (ODD a1 a2 a3 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a123*b123)- (a1*b0 - a2*b12 + a3*b31 - a123*b23)- (a2*b0 + a1*b12 - a3*b23 - a123*b31)- (a3*b0 - a1*b31 + a2*b23 - a123*b12)- (a1*b123 + a123*b1 + a2*b3 - a3*b2)- (a2*b123 + a123*b2 - a1*b3 + a3*b1)- (a3*b123 + a123*b3 + a1*b2 - a2*b1)- (a123*b0 + a1*b23 + a2*b31 + a3*b12)-- (TPV a23 a31 a12 a123) * (ODD b1 b2 b3 b123) = APS (negate $ a123*b123)- (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)- (a123*b1) (a123*b2) (a123*b3)- (a23*b1 + a31*b2 + a12*b3)- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a123*b123)- (a0*b1 + a12*b2 - a31*b3 - a23*b123)- (a0*b2 - a12*b1 + a23*b3 - a31*b123)- (a0*b3 + a31*b1 - a23*b2 - a12*b123)- (a1*b123 + a123*b1 + a2*b3 - a3*b2)- (a2*b123 + a123*b2 - a1*b3 + a3*b1)- (a3*b123 + a123*b3 + a1*b2 - a2*b1)- (a0*b123 + a23*b1 + a31*b2 + a12*b3)-- (TPV a23 a31 a12 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)- (negate $ a23*b123 + a123*b23) (negate $ a31*b123 + a123*b31) (negate $ a12*b123 + a123*b12)- (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)- 0-- (TPV a23 a31 a12 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)- (a12*b2 - a31*b3 - a23*b123 - a123*b23)- (a23*b3 - a12*b1 - a31*b123 - a123*b31)- (a31*b1 - a23*b2 - a12*b123 - a123*b12)- (a23*b0 + a123*b1 - a31*b12 + a12*b31)- (a31*b0 + a123*b2 + a23*b12 - a12*b23)- (a12*b0 + a123*b3 - a23*b31 + a31*b23)- (a123*b0 + a23*b1 + a31*b2 + a12*b3)-- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)- (a3*b31 - a2*b12 - a23*b123 - a123*b23)- (a1*b12 - a3*b23 - a31*b123 - a123*b31)- (a2*b23 - a1*b31 - a12*b123 - a123*b12)- (a0*b23 + a1*b123 - a31*b12 + a12*b31)- (a0*b31 + a2*b123 + a23*b12 - a12*b23)- (a0*b12 + a3*b123 - a23*b31 + a31*b23)- (a0*b123 + a1*b23 + a2*b31 + a3*b12)-- (APS a0 a1 a2 a3 a23 a31 a12 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12 - a123*b123)- (a0*b1 + a1*b0 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a23*b123 - a123*b23)- (a0*b2 + a2*b0 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a31*b123 - a123*b31)- (a0*b3 + a3*b0 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a12*b123 - a123*b12)- (a0*b23 + a23*b0 + a1*b123 + a123*b1 + a2*b3 - a3*b2 - a31*b12 + a12*b31)- (a0*b31 + a31*b0 - a1*b3 + a3*b1 + a2*b123 + a123*b2 + a23*b12 - a12*b23)- (a0*b12 + a12*b0 + a1*b2 - a2*b1 + a3*b123 + a123*b3 - a23*b31 + a31*b23)- (a0*b123 + a123*b0 + a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)--- -- |'abs' is the spectral norm aka the spectral radius- -- it is the largest singular value. This function may need to be fiddled with- -- to make the math a bit safer wrt overflows. This makes use of the largest- -- singular value, if the smallest singular value is zero then the element is not- -- invertable, we can see here that R, C, V3, BV, and H are all invertable.- abs (R a0) = R (abs a0) -- absolute value of a real number- abs (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2)) -- magnitude of a vector- abs (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2)) -- magnitude of a bivector- abs (I a123) = R (abs a123) -- magnitude of a Imaginary number- abs (PV a0 a1 a2 a3) = R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 + 2 * abs a0 * sqrt (a1^2 + a2^2 + a3^2)))- abs (H a0 a23 a31 a12) = R (sqrt (a0^2 + a23^2 + a31^2 + a12^2)) -- largest singular value- abs (C a0 a123) = R (sqrt (a0^2 + a123^2)) -- magnitude of a complex number- abs (BPV a1 a2 a3 a23 a31 a12) = R (sqrt (a1^2 + a23^2 + a2^2 + a31^2 + a3^2 + a12^2 +- 2 * sqrt ((a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2)))- abs (ODD a1 a2 a3 a123) = R (sqrt (a1^2 + a2^2 + a3^2 + a123^2))- abs (TPV a23 a31 a12 a123) = R (sqrt (a23^2 + a31^2 + a12^2 + a123^2 + 2 * abs a123 * sqrt (a23^2 + a31^2 + a12^2)))- abs (APS a0 a1 a2 a3 a23 a31 a12 a123) = R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 +- 2 * sqrt ((a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 +- (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2)))--- -- |'signum' satisfies the Law "abs x * signum x == x"- -- kind of cool: signum of a vector is the unit vector.- signum cliffor- | abs cliffor == 0 = 0 -- initially this was abs cliffor < tol, but this caused problems with 'spectraldcmp'- | otherwise =- let (R mag) = abs cliffor- in cliffor * R (recip mag)--- -- |'fromInteger'- fromInteger int = R (fromInteger int)--- -- |'negate' simply distributes into the grade components- negate (R a0) = R (negate a0)- negate (V3 a1 a2 a3) = V3 (negate a1) (negate a2) (negate a3)- negate (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)- negate (I a123) = I (negate a123)- negate (PV a0 a1 a2 a3) = PV (negate a0)- (negate a1) (negate a2) (negate a3)- negate (H a0 a23 a31 a12) = H (negate a0)- (negate a23) (negate a31) (negate a12)- negate (C a0 a123) = C (negate a0)- (negate a123)- negate (BPV a1 a2 a3 a23 a31 a12) = BPV (negate a1) (negate a2) (negate a3)- (negate a23) (negate a31) (negate a12)- negate (ODD a1 a2 a3 a123) = ODD (negate a1) (negate a2) (negate a3)- (negate a123)- negate (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12)- (negate a123)- negate (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS (negate a0)- (negate a1) (negate a2) (negate a3)- (negate a23) (negate a31) (negate a12)- (negate a123)----- |Cl(3,0) has a Fractional instance-instance Fractional Cl3 where- -- |Some of the sub algebras are division algebras but APS is not a division algebra- recip (R a0) = R (recip a0) -- R is a division algebra- recip v@(V3 a1 a2 a3) =- let (R mag) = abs v- sqmag = mag * mag :: Double- in V3 (a1 / sqmag) (a2 / sqmag) (a3 / sqmag)- recip bv@(BV a23 a31 a12) =- let (R mag) = abs bv- sqmag = mag * mag :: Double- in BV (negate $ a23 / sqmag) (negate $ a31 / sqmag) (negate $ a12 / sqmag)- recip i@(I a123) =- let (R mag) = abs i- sqmag = mag * mag :: Double- in I (negate $ a123 / sqmag)- recip pv@PV{} =- let mag = toR $ pv * bar pv- in recip mag * bar pv- recip h@(H a0 a23 a31 a12) = -- H is a division algebra- let (R mag) = abs h- sqmag = mag * mag :: Double- in H (a0 / sqmag) (negate $ a23 / sqmag) (negate $ a31 / sqmag) (negate $ a12 / sqmag)- recip z@(C a0 a123) = -- C is a division algebra- let (R mag) = abs z- sqmag = mag * mag :: Double- in C (a0 / sqmag) (negate $ a123 / sqmag)- recip bpv@BPV{} = reduce $ spectraldcmp recip recip' bpv- recip od@(ODD a1 a2 a3 a123) =- let (R mag) = abs od- sqmag = mag * mag :: Double- in ODD (a1 / sqmag) (a2 / sqmag) (a3 / sqmag) (negate $ a123 / sqmag)- recip tpv@TPV{} =- let mag = toR $ tpv * bar tpv- in recip mag * bar tpv- recip aps@APS{} = reduce $ spectraldcmp recip recip' aps-- -- |'fromRational'- fromRational rat = R (fromRational rat)----- |Cl(3,0) has a "Floating" instance.-instance Floating Cl3 where- pi = R pi-- --- exp (R a0) = R (exp a0)- exp (I a123) = C (cos a123) (sin a123)- exp (C a0 a123) =- let expa0 = exp a0- in C (expa0 * cos a123) (expa0 * sin a123)- exp cliffor = reduce $ spectraldcmp exp exp' cliffor-- --- log (R a0) | a0 >= 0 = R (log a0)- | otherwise = C (log (negate a0)) pi- log (I a123) = C (log (abs a123)) (signum a123 * (pi/2))- log (C a0 a123) = C (log (sqrt (a0^2 + a123^2))) (atan2 a123 a0)- log cliffor = reduce $ spectraldcmp log log' cliffor-- --- sqrt (R a0) | a0 >= 0 = R (sqrt a0)- | otherwise = I (sqrt $ negate a0)- sqrt (I a123) = C u (if a123 < 0 then -v else v)- where v = if u < tol' then 0 else abs a123 / (2 * u)- u = sqrt (abs a123 / 2)- sqrt (C a0 a123) = C u (if a123 < 0 then -v else v)- where (u,v) = if a0 < 0 then (v',u') else (u',v')- v' = if u' < tol' then 0 else abs a123 / (u'*2)- u' = sqrt ((sqrt (a0^2 + a123^2) + abs a0) / 2)- sqrt cliffor = reduce $ spectraldcmp sqrt sqrt' cliffor-- --- sin (R a0) = R (sin a0)- sin (I a123) = I (sinh a123)- sin (C a0 a123) = C (sin a0 * cosh a123) (cos a0 * sinh a123)- sin cliffor = reduce $ spectraldcmp sin sin' cliffor-- --- cos (R a0) = R (cos a0)- cos (I a123) = R (cosh a123)- cos (C a0 a123) = C (cos a0 * cosh a123) (negate $ sin a0 * sinh a123)- cos cliffor = reduce $ spectraldcmp cos cos' cliffor-- --- tan (R a0) = R (tan a0)- tan (I a123) = I (tanh a123)- tan (C a0 a123) = C (sinx*coshy) (cosx*sinhy) / C (cosx*coshy) (negate $ sinx*sinhy)- where sinx = sin a0- cosx = cos a0- sinhy = sinh a123- coshy = cosh a123- tan cliffor = reduce $ spectraldcmp tan tan' cliffor-- --- asin (R a0) = if (-1) <= a0 && a0 <= 1 then R (asin a0) else asin $ C a0 0- asin (I a123) = I (asinh a123)- asin (C a0 a123) = C a123' (-a0')- where (C a0' a123') = toC $ log (C (-a123) a0 + sqrt (1 - C a0 a123 * C a0 a123)) -- check this- asin cliffor = reduce $ spectraldcmp asin asin' cliffor-- --- acos (R a0) = if (-1) <= a0 && a0 <= 1 then R (acos a0) else acos $ C a0 0- acos (I a123) = C (pi/2) (negate $ asinh a123)- acos (C a0 a123) = C a123'' (-a0'')- where (C a0'' a123'') = log (C a0 a123 + C (-a123') a0') -- check this- (C a0' a123') = sqrt (1 - C a0 a123 * C a0 a123) -- check this- acos cliffor = reduce $ spectraldcmp acos acos' cliffor-- -- - atan (R a0) = R (atan a0)- atan (I a123) = C a123' (-a0')- where (C a0' a123') = toC.log $ ( R (1-a123) / sqrt (R (1 - a123^2))) -- check this- atan (C a0 a123) = C a123' (-a0')- where (C a0' a123') = toC $ log (C (1-a123) a0 / sqrt (1 + C a0 a123 * C a0 a123)) -- check this- atan cliffor = reduce $ spectraldcmp atan atan' cliffor-- --- sinh (R a0) = R (sinh a0)- sinh (I a123) = I (sin a123)- sinh (C a0 a123) = C (cos a123 * sinh a0) (sin a123 * cosh a0)- sinh cliffor = reduce $ spectraldcmp sinh sinh' cliffor-- --- cosh (R a0) = R (cosh a0)- cosh (I a123) = R (cos a123)- cosh (C a0 a123) = C (cos a123 * cosh a0) (sin a123 * sinh a0)- cosh cliffor = reduce $ spectraldcmp cosh cosh' cliffor-- --- tanh (R a0) = R (tanh a0)- tanh (I a123) = I (tan a123)- tanh (C a0 a123) = C (cosy*sinhx) (siny*coshx) / C (cosy*coshx) (siny*sinhx)- where siny = sin a123- cosy = cos a123- sinhx = sinh a0- coshx = cosh a0- tanh cliffor = reduce $ spectraldcmp tanh tanh' cliffor-- --- asinh (R a0) = R (asinh a0)- asinh (I a123) = log (I a123 + sqrt (R (1 - a123^2)))- asinh (C a0 a123) = log (C a0 a123 + sqrt (1 + C a0 a123 * C a0 a123))- asinh cliffor = reduce $ spectraldcmp asinh asinh' cliffor-- --- acosh (R a0) = log (R a0 + sqrt(R a0 - 1) * sqrt(R a0 + 1))- acosh (I a123) = log (I a123 + sqrt(I a123 - 1) * sqrt(I a123 + 1))- acosh (C a0 a123) = log (C a0 a123 + sqrt(C a0 a123 - 1) * sqrt(C a0 a123 + 1))- acosh cliffor = reduce $ spectraldcmp acosh acosh' cliffor-- --- atanh (R a0) = 0.5 * log (1 + R a0) - 0.5 * log (1 - R a0)- atanh (I a123) = 0.5 * log (1 + I a123) - 0.5 * log (1 - I a123)- atanh (C a0 a123) = 0.5 * log (1 + C a0 a123) - 0.5 * log (1 - C a0 a123)- atanh cliffor = reduce $ spectraldcmp atanh atanh' cliffor------ |'lsv' the littlest singular value. Useful for testing for invertability.-lsv :: Cl3 -> Cl3-lsv (R a0) = R (abs a0) -- absolute value of a real number-lsv (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2)) -- magnitude of a vector-lsv (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2)) -- magnitude of a bivector-lsv (I a123) = R (abs a123)-lsv (PV a0 a1 a2 a3) = R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 -- 2 * abs a0 * sqrt (a1^2 + a2^2 + a3^2)))-lsv (H a0 a23 a31 a12) = R (sqrt (a0^2 + a23^2 + a31^2 + a12^2))-lsv (C a0 a123) = R (sqrt (a0^2 + a123^2)) -- magnitude of a complex number-lsv (BPV a1 a2 a3 a23 a31 a12) = R (sqrt (a1^2 + a23^2 + a2^2 + a31^2 + a3^2 + a12^2 -- 2 * sqrt ((a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2)))-lsv (ODD a1 a2 a3 a123) = R (sqrt (a1^2 + a2^2 + a3^2 + a123^2))-lsv (TPV a23 a31 a12 a123) = R (sqrt (a23^2 + a31^2 + a12^2 + a123^2 - (abs a123 + abs a123) * sqrt (a23^2 + a31^2 + a12^2)))-lsv (APS a0 a1 a2 a3 a23 a31 a12 a123) = R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 -- 2 * sqrt ((a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 +- (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2)))------ | 'spectraldcmp' the spectral decomposition of a function to calculate analytic functions of cliffors in Cl(3,0).--- This function requires the desired function to be calculated and it's derivative.--- If multiple functions are being composed, its best to pass the composition of the funcitons--- to this function and the derivative to this function. Any function with a Taylor Series--- approximation should be able to be used. A real, imaginary, and complex version of the function to be decomposed--- must be provided and spectraldcmp will handle the case for an arbitrary Cliffor.--- --- It may be possible to add, in the future, a RULES pragma like:------ > "spectral decomposition function composition"--- > forall f f' g g' cliff.--- > spectraldcmp f f' (spectraldcmp g g' cliff) = spectraldcmp (f.g) (f'.g') cliff--- --- -spectraldcmp :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3-spectraldcmp fun fun' (reduce -> cliffor) = dcmp cliffor- where- dcmp (r@R{}) = fun r- dcmp (v@V3{}) = spectraldcmpSpecial toR fun v -- spectprojR fun v- dcmp (bv@BV{}) = spectraldcmpSpecial toI fun bv -- spectprojI fun bv- dcmp (i@I{}) = fun i- dcmp (pv@PV{}) = spectraldcmpSpecial toR fun pv -- spectprojR fun pv- dcmp (h@H{}) = spectraldcmpSpecial toC fun h -- spectprojC fun h- dcmp (c@C{}) = fun c- dcmp (bpv@BPV{})- | hasNilpotent bpv = jordan toR fun fun' bpv -- jordan normal form Cl3 style- | isColinear bpv = spectraldcmpSpecial toC fun bpv -- spectprojC fun bpv- | otherwise = -- transform it so it will be colinear- let (v,d,v_bar) = boost2colinear bpv- in v * spectraldcmpSpecial toC fun d * v_bar -- v * spectprojC fun d * v_bar- dcmp (od@ODD{}) = spectraldcmpSpecial toC fun od -- spectprojC fun od- dcmp (tpv@TPV{}) = spectraldcmpSpecial toI fun tpv -- spectprojI fun tpv- dcmp (aps@APS{})- | hasNilpotent aps = jordan toC fun fun' aps -- jordan normal form Cl3 style- | isColinear aps = spectraldcmpSpecial toC fun aps -- spectprojC fun aps- | otherwise = -- transform it so it will be colinear- let (v,d,v_bar) = boost2colinear aps- in v * spectraldcmpSpecial toC fun d * v_bar -- v * spectprojC fun d * v_bar------- | 'jordan' does a Cl(3,0) version of the decomposition into Jordan Normal Form and Matrix Function Calculation--- The intended use is for calculating functions for cliffors with vector parts simular to Nilpotent.--- It is a helper function for 'spectproj'. It is fortunate because eigen decomposition doesn't--- work with elements with nilpotent content, so it fills the gap.-jordan :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3-jordan toSpecial fun fun' cliffor =- let eigs = toSpecial cliffor- in fun eigs + fun' eigs * toBPV cliffor---- | 'spectraldcmpSpecial' helper function for with specialization for real, imaginary, or complex eigenvalues.--- To specialize for Reals pass 'toR', to specialize for Imaginary pass 'toI', to specialize for Complex pass 'toC'-spectraldcmpSpecial :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3-spectraldcmpSpecial toSpecial function cliffor =- let (p,p_bar,eig1,eig2) = projEigs toSpecial cliffor- in function eig1 * p + function eig2 * p_bar------ | 'eigvals' calculates the eignenvalues of the cliffor.--- This is useful for determining if a cliffor is the pole--- of a function.-eigvals :: Cl3 -> (Cl3,Cl3)-eigvals (reduce -> cliffor) = eigv cliffor- where- eigv (r@R{}) = (r,r)- eigv (v@V3{}) = eigvalsSpecial toR v -- eigvalsR v- eigv (bv@BV{}) = eigvalsSpecial toI bv -- eigvalsI bv- eigv (i@I{}) = (i,i)- eigv (pv@PV{}) = eigvalsSpecial toR pv -- eigvalsR pv- eigv (h@H{}) = eigvalsSpecial toC h -- eigvalsC h- eigv (c@C{}) = (c,c)- eigv (bpv@BPV{})- | hasNilpotent bpv = (0,0) -- this case is actually nilpotent- | isColinear bpv = eigvalsSpecial toC bpv -- eigvalsC bpv- | otherwise = -- transform it so it will be colinear- let (_,d,_) = boost2colinear bpv- in eigvalsSpecial toC d -- eigvalsC d- eigv (od@ODD{}) = eigvalsSpecial toC od -- eigvalsC od- eigv (tpv@TPV{}) = eigvalsSpecial toI tpv -- eigvalsI tpv- eigv (aps@APS{})- | hasNilpotent aps = (toC aps,toC aps) -- a scalar plus nilpotent- | isColinear aps = eigvalsSpecial toC aps -- eigvalsC aps- | otherwise = -- transform it so it will be colinear- let (_,d,_) = boost2colinear aps- in eigvalsSpecial toC d -- eigvalsC d------- | 'eigvalsSpecial' helper function to calculate Eigenvalues-eigvalsSpecial :: (Cl3 -> Cl3) -> Cl3 -> (Cl3,Cl3)-eigvalsSpecial toSpecial cliffor =- let (_,_,eig1,eig2) = projEigs toSpecial cliffor- in (eig1,eig2)----- | 'project' makes a projector based off of the vector content of the Cliffor.--- We have safty problem with unreduced values, so it calls reduce first, as a view pattern.-project :: Cl3 -> Cl3-project (reduce -> cliffor) = proj cliffor- where- proj (R{}) = PV 0.5 0 0 0.5 -- default to e3 direction- proj (v@V3{}) = 0.5 * (1 + signum v)- proj (bv@BV{}) = 0.5 * (1 + signum (toV3 $ mI * toBV bv))- proj (I{}) = PV 0.5 0 0 0.5 -- default to e3 direction- proj (pv@PV{}) = 0.5 * (1 + signum (toV3 pv))- proj (h@H{}) = 0.5 * (1 + signum (toV3 $ mI * toBV h))- proj (C{}) = PV 0.5 0 0 0.5 -- default to e3 direction- proj (bpv@BPV{})- | abs (toV3 bpv + toV3 (mI * toBV bpv)) <= tol = 0.5 * (1 + signum (toV3 bpv)) -- gaurd for equal and opposite- | otherwise = 0.5 * (1 + signum (toV3 bpv + toV3 (mI * toBV bpv)))- proj (od@ODD{}) = 0.5 * (1 + signum (toV3 od))- proj (tpv@TPV{}) = 0.5 * (1 + signum (toV3 $ mI * toBV tpv))- proj (aps@APS{}) = project.toBPV $ aps----- | 'boost2colinear' calculates a boost that is perpendicular to both the vector and bivector--- components, that will mix the vector and bivector parts such that the vector and bivector--- parts become colinear. This function is a simularity transform such that--- cliffor = v * d * bar v and returns v, d, and v_bar as a tuple. First v must be calculated--- and then d = bar v * cliffor * v. d will have colinear vector and bivector parts.--- This is somewhat simular to finding the drift frame for an electromagnetic field.-boost2colinear :: Cl3 -> (Cl3, Cl3, Cl3)-boost2colinear cliffor =- let v = toV3 cliffor -- extract the vector- bv = mI * toBV cliffor -- extract the bivector and turn it into a vector- invariant = (2 * mI * toBV (v * bv)) / toR (v^2 + bv^2)- boost = spectraldcmpSpecial toR (exp.(/4).atanh) invariant- boost_bar = bar boost- d = boost_bar * cliffor * boost- in (boost, d, boost_bar)----- | 'isColinear' takes a Cliffor and determines if the vector part and the bivector part are--- not at all orthoganl and non-zero.-isColinear :: Cl3 -> Bool-isColinear cliffor = abs (toV3 cliffor) /= 0 && abs (mI * toBV cliffor) /= 0 && -- Non-Zero- abs (toBV $ signum (toV3 cliffor) * signum (mI * toBV cliffor)) <= tol -- Not Orthoganl----- | 'hasNilpotent' takes a Cliffor and determines if the vector part and the bivector part are--- orthoganl and equal in magnitude, i.e. that it is simular to a nilpotent BPV.-hasNilpotent :: Cl3 -> Bool-hasNilpotent cliffor = abs (toV3 cliffor) /= 0 && abs (mI * toBV cliffor) /= 0 && -- Non-Zero- abs (toR $ signum (toV3 cliffor) * signum (mI * toBV cliffor)) <= tol && -- Orthoganl- abs (abs (toV3 cliffor) - abs (toBV cliffor)) <= tol -- Equal Magnitude----- | 'projEigs' function returns complementary projectors and eigenvalues for a Cliffor with specialization.--- The Cliffor at this point is allready colinear and the Eigenvalue is known to be real, imaginary, or complex.-projEigs :: (Cl3 -> Cl3) -> Cl3 -> (Cl3,Cl3,Cl3,Cl3)-projEigs toSpecial cliffor =- let p = project cliffor- p_bar = bar p- eig1 = 2 * (toSpecial $ p * cliffor * p)- eig2 = 2 * (toSpecial $ p_bar * cliffor * p_bar)- in (p,p_bar,eig1,eig2)----- | 'reduce' function reduces the number of grades in a specialized Cliffor if some are zero-reduce :: Cl3 -> Cl3-reduce r@R{} = r-reduce v@V3{} - | abs v <= tol = R 0- | otherwise = v-reduce bv@BV{}- | abs bv <= tol = R 0- | otherwise = bv-reduce i@I{}- | abs i <= tol = R 0- | otherwise = i-reduce pv@PV{}- | abs pv <= tol = R 0- | abs (toR pv) <= tol = toV3 pv- | abs (toV3 pv) <= tol = toR pv- | otherwise = pv-reduce h@H{}- | abs h <= tol = R 0- | abs (toR h) <= tol = toBV h- | abs (toBV h) <= tol = toR h- | otherwise = h-reduce c@C{}- | abs c <= tol = R 0- | abs (toR c) <= tol = toI c- | abs (toI c) <= tol = toR c - | otherwise = c-reduce bpv@BPV{}- | abs bpv <= tol = R 0- | abs (toV3 bpv) <= tol = toBV bpv- | abs (toBV bpv) <= tol = toV3 bpv- | otherwise = bpv-reduce od@ODD{}- | abs od <= tol = R 0- | abs (toV3 od) <= tol = toI od- | abs (toI od) <= tol = toV3 od- | otherwise = od-reduce tpv@TPV{}- | abs tpv <= tol = R 0- | abs (toBV tpv) <= tol = toI tpv- | abs (toI tpv) <= tol = toBV tpv- | otherwise = tpv-reduce aps@APS{}- | abs aps <= tol = R 0- | abs (toC aps) <= tol = reduce (toBPV aps)- | abs (toBPV aps) <= tol = reduce (toC aps)- | abs (toH aps) <= tol = reduce (toODD aps)- | abs (toODD aps) <= tol = reduce (toH aps)- | abs (toPV aps) <= tol = reduce (toTPV aps)- | abs (toTPV aps) <= tol = reduce (toPV aps)- | otherwise = aps---- | 'mI' negative i-mI :: Cl3-mI = I (-1)---- | 'tol' currently 128*eps-tol :: Cl3-tol = R $ 128 * 1.1102230246251565e-16--tol' :: Double-tol' = 128 * 1.1102230246251565e-16----- | 'bar' is a Clifford Conjugate, the vector grades are negated-bar :: Cl3 -> Cl3-bar (R a0) = R a0-bar (V3 a1 a2 a3) = V3 (negate a1) (negate a2) (negate a3)-bar (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)-bar (I a123) = I a123-bar (PV a0 a1 a2 a3) = PV a0 (negate a1) (negate a2) (negate a3)-bar (H a0 a23 a31 a12) = H a0 (negate a23) (negate a31) (negate a12)-bar (C a0 a123) = C a0 a123-bar (BPV a1 a2 a3 a23 a31 a12) = BPV (negate a1) (negate a2) (negate a3) (negate a23) (negate a31) (negate a12)-bar (ODD a1 a2 a3 a123) = ODD (negate a1) (negate a2) (negate a3) a123-bar (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12) a123-bar (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 (negate a1) (negate a2) (negate a3) (negate a23) (negate a31) (negate a12) a123---- | 'dag' is the Complex Conjugate, the imaginary grades are negated-dag :: Cl3 -> Cl3-dag (R a0) = R a0-dag (V3 a1 a2 a3) = V3 a1 a2 a3-dag (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)-dag (I a123) = I (negate a123)-dag (PV a0 a1 a2 a3) = PV a0 a1 a2 a3-dag (H a0 a23 a31 a12) = H a0 (negate a23) (negate a31) (negate a12)-dag (C a0 a123) = C a0 (negate a123)-dag (BPV a1 a2 a3 a23 a31 a12) = BPV a1 a2 a3 (negate a23) (negate a31) (negate a12)-dag (ODD a1 a2 a3 a123) = ODD a1 a2 a3 (negate a123)-dag (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12) (negate a123)-dag (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 a1 a2 a3 (negate a23) (negate a31) (negate a12) (negate a123)--------------------------------------------------------------------------------------------------------------------- the to... functions provide a lossy cast from one Cliffor to another------------------------------------------------------------------------------------------------------------------- | 'toR' takes any Cliffor and returns the R portion-toR :: Cl3 -> Cl3-toR (R a0) = R a0-toR V3{} = R 0-toR BV{} = R 0-toR I{} = R 0-toR (PV a0 _ _ _) = R a0-toR (H a0 _ _ _) = R a0-toR (C a0 _) = R a0-toR BPV{} = R 0-toR ODD{} = R 0-toR TPV{} = R 0-toR (APS a0 _ _ _ _ _ _ _) = R a0---- | 'toV3' takes any Cliffor and returns the V3 portion-toV3 :: Cl3 -> Cl3-toV3 R{} = V3 0 0 0-toV3 (V3 a1 a2 a3) = V3 a1 a2 a3-toV3 BV{} = V3 0 0 0-toV3 I{} = V3 0 0 0-toV3 (PV _ a1 a2 a3) = V3 a1 a2 a3-toV3 H{} = V3 0 0 0-toV3 C{} = V3 0 0 0-toV3 (BPV a1 a2 a3 _ _ _) = V3 a1 a2 a3-toV3 (ODD a1 a2 a3 _) = V3 a1 a2 a3-toV3 TPV{} = V3 0 0 0-toV3 (APS _ a1 a2 a3 _ _ _ _) = V3 a1 a2 a3---- | 'toBV' takes any Cliffor and returns the BV portion-toBV :: Cl3 -> Cl3-toBV R{} = BV 0 0 0-toBV V3{} = BV 0 0 0-toBV (BV a23 a31 a12) = BV a23 a31 a12-toBV I{} = BV 0 0 0-toBV PV{} = BV 0 0 0-toBV (H _ a23 a31 a12) = BV a23 a31 a12-toBV C{} = BV 0 0 0-toBV (BPV _ _ _ a23 a31 a12) = BV a23 a31 a12-toBV ODD{} = BV 0 0 0-toBV (TPV a23 a31 a12 _) = BV a23 a31 a12-toBV (APS _ _ _ _ a23 a31 a12 _) = BV a23 a31 a12---- | 'toI' takes any Cliffor and returns the I portion-toI :: Cl3 -> Cl3-toI R{} = I 0-toI V3{} = I 0-toI BV{} = I 0-toI (I a123) = I a123-toI PV{} = I 0-toI H{} = I 0-toI (C _ a123) = I a123-toI BPV{} = I 0-toI (ODD _ _ _ a123) = I a123-toI (TPV _ _ _ a123) = I a123-toI (APS _ _ _ _ _ _ _ a123) = I a123---- | 'toPV' takes any Cliffor and returns the PV poriton-toPV :: Cl3 -> Cl3-toPV (R a0) = PV a0 0 0 0-toPV (V3 a1 a2 a3) = PV 0 a1 a2 a3-toPV BV{} = PV 0 0 0 0-toPV I{} = PV 0 0 0 0-toPV (PV a0 a1 a2 a3) = PV a0 a1 a2 a3-toPV (H a0 _ _ _) = PV a0 0 0 0-toPV (C a0 _) = PV a0 0 0 0-toPV (BPV a1 a2 a3 _ _ _) = PV 0 a1 a2 a3-toPV (ODD a1 a2 a3 _) = PV a1 a2 a3 0-toPV TPV{} = PV 0 0 0 0-toPV (APS a0 a1 a2 a3 _ _ _ _) = PV a0 a1 a2 a3---- | 'toH' takes any Cliffor and returns the H portion-toH :: Cl3 -> Cl3-toH (R a0) = H a0 0 0 0-toH V3{} = H 0 0 0 0-toH (BV a23 a31 a12) = H 0 a23 a31 a12-toH (I _) = H 0 0 0 0-toH (PV a0 _ _ _) = H a0 0 0 0-toH (H a0 a23 a31 a12) = H a0 a23 a31 a12-toH (C a0 _) = H a0 0 0 0-toH (BPV _ _ _ a23 a31 a12) = H 0 a23 a31 a12-toH ODD{} = H 0 0 0 0-toH (TPV a23 a31 a12 _) = H 0 a23 a31 a12-toH (APS a0 _ _ _ a23 a31 a12 _) = H a0 a23 a31 a12---- | 'toC' takes any Cliffor and returns the C portion-toC :: Cl3 -> Cl3-toC (R a0) = C a0 0-toC V3{} = C 0 0-toC BV{} = C 0 0-toC (I a123) = C 0 a123-toC (PV a0 _ _ _) = C a0 0-toC (H a0 _ _ _) = C a0 0-toC (C a0 a123) = C a0 a123-toC BPV{} = C 0 0-toC (ODD _ _ _ a123) = C 0 a123-toC (TPV _ _ _ a123) = C 0 a123-toC (APS a0 _ _ _ _ _ _ a123) = C a0 a123---- | 'toBPV' takes any Cliffor and returns the BPV portion-toBPV :: Cl3 -> Cl3-toBPV R{} = BPV 0 0 0 0 0 0-toBPV (V3 a1 a2 a3) = BPV a1 a2 a3 0 0 0-toBPV (BV a23 a31 a12) = BPV 0 0 0 a23 a31 a12-toBPV I{} = BPV 0 0 0 0 0 0-toBPV (PV _ a1 a2 a3) = BPV a1 a2 a3 0 0 0-toBPV (H _ a23 a31 a12) = BPV 0 0 0 a23 a31 a12-toBPV C{} = BPV 0 0 0 0 0 0-toBPV (BPV a1 a2 a3 a23 a31 a12) = BPV a1 a2 a3 a23 a31 a12-toBPV (ODD a1 a2 a3 _) = BPV a1 a2 a3 0 0 0-toBPV (TPV a23 a31 a12 _) = BPV 0 0 0 a23 a31 a12-toBPV (APS _ a1 a2 a3 a23 a31 a12 _) = BPV a1 a2 a3 a23 a31 a12---- | 'toODD' takes any Cliffor and returns the ODD portion-toODD :: Cl3 -> Cl3-toODD R{} = ODD 0 0 0 0-toODD (V3 a1 a2 a3) = ODD a1 a2 a3 0-toODD BV{} = ODD 0 0 0 0-toODD (I a123) = ODD 0 0 0 a123-toODD (PV _ a1 a2 a3) = ODD a1 a2 a3 0-toODD H{} = ODD 0 0 0 0-toODD (C _ a123) = ODD 0 0 0 a123-toODD (BPV a1 a2 a3 _ _ _) = ODD a1 a2 a3 0-toODD (ODD a1 a2 a3 a123) = ODD a1 a2 a3 a123-toODD (TPV _ _ _ a123) = ODD 0 0 0 a123-toODD (APS _ a1 a2 a3 _ _ _ a123) = ODD a1 a2 a3 a123---- | 'toTPV' takes any Cliffor and returns the TPV portion-toTPV :: Cl3 -> Cl3-toTPV R{} = TPV 0 0 0 0-toTPV V3{} = TPV 0 0 0 0-toTPV (BV a23 a31 a12) = TPV a23 a31 a12 0-toTPV (I a123) = TPV 0 0 0 a123-toTPV PV{} = TPV 0 0 0 0-toTPV (H _ a23 a31 a12) = TPV a23 a31 a12 0-toTPV (C _ a123) = TPV 0 0 0 a123-toTPV (BPV _ _ _ a23 a31 a12) = TPV a23 a31 a12 0-toTPV (ODD _ _ _ a123) = TPV 0 0 0 a123-toTPV (TPV a23 a31 a12 a123) = TPV a23 a31 a12 a123-toTPV (APS _ _ _ _ a23 a31 a12 a123) = TPV a23 a31 a12 a123---- | 'toAPS' takes any Cliffor and returns the APS portion-toAPS :: Cl3 -> Cl3-toAPS (R a0) = APS a0 0 0 0 0 0 0 0-toAPS (V3 a1 a2 a3) = APS 0 a1 a2 a3 0 0 0 0-toAPS (BV a23 a31 a12) = APS 0 0 0 0 a23 a31 a12 0-toAPS (I a123) = APS 0 0 0 0 0 0 0 a123-toAPS (PV a0 a1 a2 a3) = APS a0 a1 a2 a3 0 0 0 0-toAPS (H a0 a23 a31 a12) = APS a0 0 0 0 a23 a31 a12 0-toAPS (C a0 a123) = APS a0 0 0 0 0 0 0 a123-toAPS (BPV a1 a2 a3 a23 a31 a12) = APS 0 a1 a2 a3 a23 a31 a12 0-toAPS (ODD a1 a2 a3 a123) = APS 0 a1 a2 a3 0 0 0 a123-toAPS (TPV a23 a31 a12 a123) = APS 0 0 0 0 a23 a31 a12 a123-toAPS (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 a1 a2 a3 a23 a31 a12 a123---- derivatives of the functions in the Fractional Class for use in Jordan NF functon implemetnation-recip' :: Cl3 -> Cl3-recip' x = negate.recip $ x * x -- pole at 0--exp' :: Cl3 -> Cl3-exp' = exp--log' :: Cl3 -> Cl3-log' = recip -- pole at 0--sqrt' :: Cl3 -> Cl3-sqrt' x = 0.5 * recip (sqrt x) -- pole at 0--sin' :: Cl3 -> Cl3-sin' = cos--cos' :: Cl3 -> Cl3-cos' = negate.sin--tan' :: Cl3 -> Cl3-tan' x = recip (cos x) * recip (cos x) -- pole at pi/2*n for all integers--asin' :: Cl3 -> Cl3-asin' x = recip.sqrt $ 1 - (x * x) -- pole at +/-1--acos' :: Cl3 -> Cl3-acos' x = negate.recip.sqrt $ 1 - (x * x) -- pole at +/-1--atan' :: Cl3 -> Cl3-atan' x = recip $ 1 + (x * x) -- pole at +/-i--sinh' :: Cl3 -> Cl3-sinh' = cosh--cosh' :: Cl3 -> Cl3-cosh' = sinh--tanh' :: Cl3 -> Cl3-tanh' x = recip (cosh x) * recip (cosh x)--asinh' :: Cl3 -> Cl3-asinh' x = recip.sqrt $ (x * x) + 1 -- pole at +/-i--acosh' :: Cl3 -> Cl3-acosh' x = recip $ sqrt (x - 1) * sqrt (x + 1) -- pole at +/-1--atanh' :: Cl3 -> Cl3-atanh' x = recip $ 1 - (x * x) -- pole at +/-1------------------------------------------------------------------------- --- Instance of Cl3 types with the "Foreign.Storable" library.--- --- For use with high performance data structures like Data.Vector.Storable--- or Data.Array.Storable--- ------------------------------------------------------------------------ | Cl3 instance of Storable uses the APS constructor as its standard interface.--- "peek" returns a cliffor constructed with APS. "poke" converts a cliffor to APS.-instance Storable Cl3 where- sizeOf _ = 8 * sizeOf (undefined :: Double)- alignment _ = sizeOf (undefined :: Double)- peek ptr = do- a0 <- peek (offset 0)- a1 <- peek (offset 1)- a2 <- peek (offset 2)- a3 <- peek (offset 3)- a23 <- peek (offset 4)- a31 <- peek (offset 5)- a12 <- peek (offset 6)- a123 <- peek (offset 7)- return $ APS a0 a1 a2 a3 a23 a31 a12 a123- where- offset i = (castPtr ptr :: Ptr Double) `plusPtr` (i*8)- - poke ptr (toAPS -> APS a0 a1 a2 a3 a23 a31 a12 a123) = do- poke (offset 0) a0- poke (offset 1) a1- poke (offset 2) a2- poke (offset 3) a3- poke (offset 4) a23- poke (offset 5) a31- poke (offset 6) a12- poke (offset 7) a123- where- offset i = (castPtr ptr :: Ptr Double) `plusPtr` (i*8)- poke _ _ = error "Serious Issues with poke in Cl3.Storable"--------------------------------------------------------------------------- --- Random Instance of Cl3 types with the "System.Random" library.--- ------ Random helper functions will be based on the "abs x * signum x" decomposition--- for the single grade elements. The "abs x" will be the random magnitude that--- is by the default [0,1), and the "signum x" part will be a random direction--- of a vector or the sign of a scalar. The multi-grade elements will be constructed from--- a combination of the single grade generators. Each grade will be evenly--- distributed across the range.--- ------------------------------------------------------------------------ | 'Random' instance for the 'System.Random' library-instance Random Cl3 where- randomR (minAbs,maxAbs) g =- case randomR (fromEnum (minBound :: ConCl3), fromEnum (maxBound :: ConCl3)) g of- (r, g') -> case toEnum r of- ConR -> rangeR (minAbs,maxAbs) g'- ConV3 -> rangeV3 (minAbs,maxAbs) g'- ConBV -> rangeBV (minAbs,maxAbs) g'- ConI -> rangeI (minAbs,maxAbs) g'- ConPV -> rangePV (minAbs,maxAbs) g'- ConH -> rangeH (minAbs,maxAbs) g'- ConC -> rangeC (minAbs,maxAbs) g'- ConBPV -> rangeBPV (minAbs,maxAbs) g'- ConODD -> rangeODD (minAbs,maxAbs) g'- ConTPV -> rangeTPV (minAbs,maxAbs) g'- ConAPS -> rangeAPS (minAbs,maxAbs) g'-- random = randomR (0,1)------ | 'ConCl3' Bounded Enum Algebraic Data Type of constructors of Cl3-data ConCl3 = ConR- | ConV3- | ConBV- | ConI- | ConPV- | ConH- | ConC- | ConBPV- | ConODD- | ConTPV- | ConAPS- deriving (Bounded, Enum)------- | 'randR' random Real Scalar (Grade 0) with random magnitude and random sign-randR :: RandomGen g => g -> (Cl3, g)-randR = rangeR (0,1)----- | 'rangeR' random Real Scalar (Grade 0) with random magnitude within a range and a random sign-rangeR :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeR = scalarHelper R----- | 'randV3' random Vector (Grade 1) with random magnitude and random direction--- the direction is using spherical coordinates-randV3 :: RandomGen g => g -> (Cl3, g)-randV3 = rangeV3 (0,1)----- | 'rangeV3' random Vector (Grade 1) with random magnitude within a range and a random direction-rangeV3 :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeV3 = vectorHelper V3----- | 'randBV' random Bivector (Grade 2) with random magnitude and random direction--- the direction is using spherical coordinates-randBV :: RandomGen g => g -> (Cl3, g)-randBV = rangeBV (0,1)----- | 'rangeBV' random Bivector (Grade 2) with random magnitude in a range and a random direction-rangeBV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeBV = vectorHelper BV----- | 'randI' random Imaginary Scalar (Grade 3) with random magnitude and random sign-randI :: RandomGen g => g -> (Cl3, g)-randI = rangeI (0,1)----- | 'rangeI' random Imaginary Scalar (Grade 3) with random magnitude within a range and random sign-rangeI :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeI = scalarHelper I----- | 'randPV' random Paravector made from random Grade 0 and Grade 1 elements-randPV :: RandomGen g => g -> (Cl3, g)-randPV = rangePV (0,1)----- | 'rangePV' random Paravector made from random Grade 0 and Grade 1 elements within a range-rangePV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangePV (lo, hi) g =- let (r, g') = rangeR (lo, hi) g- (v3, g'') = rangeV3 (lo, hi) g'- in (r + v3, g'')----- | 'randH' random Quaternion made from random Grade 0 and Grade 2 elements-randH :: RandomGen g => g -> (Cl3, g)-randH = rangeH (0,1)----- | 'rangeH' random Quaternion made from random Grade 0 and Grade 2 elements within a range-rangeH :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeH (lo, hi) g =- let (r, g') = rangeR (lo, hi) g- (bv, g'') = rangeBV (lo, hi) g'- in (r + bv, g'')----- | 'randC' random combination of Grade 0 and Grade 3-randC :: RandomGen g => g -> (Cl3, g)-randC = rangeC (0,1)----- | 'rangeC' random combination of Grade 0 and Grade 3 within a range-rangeC :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeC (lo, hi) g =- let (r, g') = rangeR (lo, hi) g- (i, g'') = rangeI (lo, hi) g'- in (r + i, g'')----- | 'randBPV' random combination of Grade 1 and Grade 2-randBPV :: RandomGen g => g -> (Cl3, g)-randBPV = rangeBPV (0,1)----- | 'rangeBPV' random combination of Grade 1 and Grade 2 within a range-rangeBPV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeBPV (lo, hi) g =- let (v3, g') = rangeV3 (lo, hi) g- (bv, g'') = rangeBV (lo, hi) g'- in (v3 + bv, g'')----- | 'randODD' random combination of Grade 1 and Grade 3-randODD :: RandomGen g => g -> (Cl3, g)-randODD = rangeODD (0,1)----- | 'rangeODD' random combination of Grade 1 and Grade 3 within a range-rangeODD :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeODD (lo, hi) g =- let (v3, g') = rangeV3 (lo, hi) g- (i, g'') = rangeI (lo, hi) g'- in (v3 + i, g'')----- | 'randTPV' random combination of Grade 2 and Grade 3-randTPV :: RandomGen g => g -> (Cl3, g)-randTPV = rangeTPV (0,1)----- | 'rangeTPV' random combination of Grade 2 and Grade 3 within a range-rangeTPV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeTPV (lo, hi) g =- let (bv, g') = rangeBV (lo, hi) g- (i, g'') = rangeI (lo, hi) g'- in (bv + i, g'')----- | 'randAPS' random combination of all 4 grades-randAPS :: RandomGen g => g -> (Cl3, g)-randAPS = rangeAPS (0,1)----- | 'rangeAPS' random combination of all 4 grades within a range-rangeAPS :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)-rangeAPS (lo, hi) g =- let (pv, g') = rangePV (lo, hi) g- (tpv, g'') = rangeTPV (lo, hi) g'- in (pv + tpv, g'')------------------------------------------------------------------------- Additional Random generators----------------------------------------------------------------------- | 'randUnitV3' a unit vector with a random direction-randUnitV3 :: RandomGen g => g -> (Cl3, g)-randUnitV3 g =- let (theta, g') = randomR (0,pi) g- (phi, g'') = randomR (0,2*pi) g'- in (V3 (sin theta * cos phi) (sin theta * sin phi) (cos theta), g'')----- | 'randProjector' a projector with a random direction-randProjector :: RandomGen g => g -> (Cl3, g)-randProjector g =- let (v3, g') = randUnitV3 g- in (0.5 + 0.5 * v3, g')----- | 'randNilpotent' a nilpotent element with a random orientation-randNilpotent :: RandomGen g => g -> (Cl3, g)-randNilpotent g =- let (p, g') = randProjector g- (v, g'') = randUnitV3 g'- vnormal = signum $ I (-1) * toBV ( toV3 p * v) -- unit vector normal to the projector- in (toBPV $ vnormal * p, g'')------------------------------------------------------------------------- helper functions---------------------------------------------------------------------magHelper :: RandomGen g => (Cl3, Cl3) -> g -> (Double, g)-magHelper (lo, hi) g =- let R lo' = abs lo- R hi' = abs hi- in randomR (lo', hi') g---scalarHelper :: RandomGen g => (Double -> Cl3) -> (Cl3, Cl3) -> g -> (Cl3, g)-scalarHelper con rng g =- let (mag, g') = magHelper rng g- (sign, g'') = random g'- in if sign- then (con mag, g'')- else (con (negate mag), g'')---vectorHelper :: RandomGen g => (Double -> Double -> Double -> Cl3) -> (Cl3, Cl3) -> g -> (Cl3, g)-vectorHelper con rng g =- let (mag, g') = magHelper rng g- (theta, g'') = randomR (0,pi) g'- (phi, g''') = randomR (0,2*pi) g''- in (con (mag * sin theta * cos phi) (mag * sin theta * sin phi) (mag * cos theta), g''')-+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-}++#if __GLASGOW_HASKELL__ == 810+-- Work around to fix GHC Issue #15304, issue popped up again in GHC 8.10, it should be fixed in GHC 8.12+-- This code is meant to reproduce MR 2608 for GHC 8.10+{-# OPTIONS_GHC -funfolding-keeness-factor=1 -funfolding-use-threshold=80 #-}+#endif++--------------------------------------------------------------------------------------------+-- |+-- Copyright : (C) 2017-2020 Nathan Waivio+-- License : BSD3+-- Maintainer : Nathan Waivio <nathan.waivio@gmail.com>+-- Stability : Stable+-- Portability : unportable+--+-- Library implementing standard functions for the <https://en.wikipedia.org/wiki/Algebra_of_physical_space Algebra of Physical Space> Cl(3,0)+-- +---------------------------------------------------------------------------------------------+++module Algebra.Geometric.Cl3+(-- * The type for the Algebra of Physical Space+ Cl3(..),+ -- * Clifford Conjugate and Complex Conjugate+ bar, dag,+ -- * The littlest singular value+ lsv,+ -- * Constructor Selectors - For optimizing and simplifying calculations+ toR, toV3, toBV, toI,+ toPV, toH, toC,+ toBPV, toODD, toTPV,+ toAPS,+ -- * Pretty Printing for use with Octave+ showOctave,+ -- * Eliminate grades that are less than 'tol' to use a simpler Constructor+ reduce, tol,+#ifndef O_NO_RANDOM+ -- * Random Instances+ randR, rangeR,+ randV3, rangeV3,+ randBV, rangeBV,+ randI, rangeI,+ randPV, rangePV,+ randH, rangeH,+ randC, rangeC,+ randBPV, rangeBPV,+ randODD, rangeODD,+ randTPV, rangeTPV,+ randAPS, rangeAPS,+ randUnitV3,+ randProjector,+ randNilpotent,+ randUnitary,+#endif+ -- * Helpful Functions+ eigvals, hasNilpotent,+ spectraldcmp, project,+ mIx, timesI+) where++#ifndef O_NO_DERIVED+import Data.Data (Typeable, Data)+import GHC.Generics (Generic)+#endif+++import Control.DeepSeq (NFData,rnf)+import Foreign.Storable (Storable, sizeOf, alignment, peek, poke)+import Foreign.Ptr (Ptr, plusPtr, castPtr)+++#ifndef O_NO_RANDOM+import System.Random (RandomGen, Random, randomR, random)+#endif+++-- | Cl3 provides specialized constructors for sub-algebras and other geometric objects+-- contained in the algebra. Cl(3,0), abbreviated to Cl3, is a Geometric Algebra+-- of 3 dimensional space known as the Algebra of Physical Space (APS). Geometric Algebras are Real+-- Clifford Algebras, double precision floats are used to approximate real numbers in this+-- library. Single and Double grade combinations are specialized using algebraic datatypes+-- and live within the APS.+--+-- * 'R' is the constructor for the Real Scalar Sub-algebra Grade-0+--+-- * 'V3' is the Three Dimensional Real Vector constructor Grade-1+--+-- * 'BV' is the Bivector constructor Grade-2 an Imaginary Three Dimensional Vector+--+-- * 'I' is the Imaginary constructor Grade-3 and is the Pseudo-Scalar for APS+--+-- * 'PV' is the Paravector constructor with Grade-0 and Grade-1 elements, a Real Scalar plus Vector, (R + V3)+--+-- * 'H' is the Quaternion constructor it is the Even Sub-algebra with Grade-0 and Grade-2 elements, a Real Scalar plus Bivector, (R + BV)+--+-- * 'C' is the Complex constructor it is the Scalar Sub-algebra with Grade-0 and Grade-3 elements, a Real Scalar plus Imaginar Scalar, (R + I)+--+-- * 'BPV' is the Biparavector constructor with Grade-1 and Grade-2 elements, a Real Vector plus Bivector, (V3 + BV)+--+-- * 'ODD' is the Odd constructor with Grade-1 and Grade-3 elements, a Vector plus Imaginary Scalar, (V3 + I)+--+-- * 'TPV' is the Triparavector constructor with Grade-2 and Grade-3 elements, a Bivector plus Imaginary, (BV + I)+--+-- * 'APS' is the constructor for an element in the Algebra of Physical Space with Grade-0 through Grade-3 elements+--+data Cl3 where+ R :: !Double -> Cl3 -- Real Scalar Sub-algebra+ V3 :: !Double -> !Double -> !Double -> Cl3 -- Three Dimensional Vectors+ BV :: !Double -> !Double -> !Double -> Cl3 -- Bivectors, Imaginary Three Dimenstional Vectors+ I :: !Double -> Cl3 -- Trivector Imaginary Pseudo-Scalar, Imaginary Scalar+ PV :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Paravector, Real Scalar plus Three Dimensional Real Vector, (R + V3)+ H :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Quaternion Even Sub-algebra, Real Scalar plus Bivector, (R + BV)+ C :: !Double -> !Double -> Cl3 -- Complex Sub-algebra, Real Scalar plus Imaginary Scalar, (R + I)+ BPV :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3 -- Biparavector, Vector plus Bivector, (V3 + BV)+ ODD :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Odd, Vector plus Imaginary, (V3 + I)+ TPV :: !Double -> !Double -> !Double -> !Double -> Cl3 -- Triparavector, Bivector plus Imaginary Scalar, (BV + I)+ APS :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3 -- Algebra of Physical Space+#ifndef O_NO_DERIVED+ deriving (Show, Read, Typeable, Data, Generic)++#else++-- | In case we don't derive Show, provide 'showOctave' as the Show instance+instance Show Cl3 where+ show = showOctave++#endif+++instance NFData Cl3 where+ rnf !_ = ()+++-- |'showOctave' for useful for debug purposes.+-- The additional octave definition is needed: +-- +-- > e0 = [1,0;0,1]; e1=[0,1;1,0]; e2=[0,-i;i,0]; e3=[1,0;0,-1];+--+-- This allows one to take advantage of the isomorphism between Cl3 and M(2,C)+showOctave :: Cl3 -> String+showOctave (R a0) = show a0 ++ "*e0"+showOctave (V3 a1 a2 a3) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3"+showOctave (BV a23 a31 a12) = show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"+showOctave (I a123) = show a123 ++ "i*e0"+showOctave (PV a0 a1 a2 a3) = show a0 ++ "*e0 + " ++ show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3"+showOctave (H a0 a23 a31 a12) = show a0 ++ "*e0 + " ++ show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"+showOctave (C a0 a123) = show a0 ++ "*e0 + " ++ show a123 ++ "i*e0"+showOctave (BPV a1 a2 a3 a23 a31 a12) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " +++ show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3"+showOctave (ODD a1 a2 a3 a123) = show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " ++ show a123 ++ "i*e0"+showOctave (TPV a23 a31 a12 a123) = show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3 + " ++ show a123 ++ "i*e0"+showOctave (APS a0 a1 a2 a3 a23 a31 a12 a123) = show a0 ++ "*e0 + " ++ show a1 ++ "*e1 + " ++ show a2 ++ "*e2 + " ++ show a3 ++ "*e3 + " +++ show a23 ++ "i*e1 + " ++ show a31 ++ "i*e2 + " ++ show a12 ++ "i*e3 + " ++ show a123 ++ "i*e0"+++-- |Cl(3,0) has the property of equivalence. "Eq" is "True" when all of the grade elements are equivalent.+instance Eq Cl3 where+ (R a0) == (R b0) = a0 == b0++ (R a0) == (V3 b1 b2 b3) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (R a0) == (BV b23 b31 b12) = a0 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (R a0) == (I b123) = a0 == 0 && b123 == 0+ (R a0) == (PV b0 b1 b2 b3) = a0 == b0 && b1 == 0 && b2 == 0 && b3 == 0+ (R a0) == (H b0 b23 b31 b12) = a0 == b0 && b23 == 0 && b31 == 0 && b12 == 0+ (R a0) == (C b0 b123) = a0 == b0 && b123 == 0+ (R a0) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (R a0) == (ODD b1 b2 b3 b123) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0+ (R a0) == (TPV b23 b31 b12 b123) = a0 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0+ (R a0) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0++ (V3 a1 a2 a3) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0+ (BV a23 a31 a12) == (R b0) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0+ (I a123) == (R b0) = a123 == 0 && b0 == 0+ (PV a0 a1 a2 a3) == (R b0) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0+ (H a0 a23 a31 a12) == (R b0) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0+ (C a0 a123) == (R b0) = a0 == b0 && a123 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0+ (ODD a1 a2 a3 a123) == (R b0) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b0 == 0+ (TPV a23 a31 a12 a123) == (R b0) = a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0 && b0 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (R b0) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0++ (V3 a1 a2 a3) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3++ (V3 a1 a2 a3) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (V3 a1 a2 a3) == (I b123) = a1 == 0 && a2 == 0 && a3 == 0 && b123 == 0+ (V3 a1 a2 a3) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && b0 == 0+ (V3 a1 a2 a3) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (V3 a1 a2 a3) == (C b0 b123) = a1 == 0 && a2 == 0 && a3 == 0 && b0 == 0 && b123 == 0+ (V3 a1 a2 a3) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0+ (V3 a1 a2 a3) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0+ (V3 a1 a2 a3) == (TPV b23 b31 b12 b123) = a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0+ (V3 a1 a2 a3) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0++ (BV a23 a31 a12) == (V3 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (I a123) == (V3 b1 b2 b3) = a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (PV a0 a1 a2 a3) == (V3 b1 b2 b3) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3+ (H a0 a23 a31 a12) == (V3 b1 b2 b3) = a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (C a0 a123) == (V3 b1 b2 b3) = a0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0+ (ODD a1 a2 a3 a123) == (V3 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0+ (TPV a23 a31 a12 a123) == (V3 b1 b2 b3) = b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (V3 b1 b2 b3) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0++ (BV a23 a31 a12) == (BV b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12++ (BV a23 a31 a12) == (I b123) = a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0+ (BV a23 a31 a12) == (PV b0 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (BV a23 a31 a12) == (H b0 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0+ (BV a23 a31 a12) == (C b0 b123) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b123 == 0+ (BV a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0+ (BV a23 a31 a12) == (ODD b1 b2 b3 b123) = a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0+ (BV a23 a31 a12) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0+ (BV a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0++ (I a123) == (BV b23 b31 b12) = a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (PV a0 a1 a2 a3) == (BV b23 b31 b12) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (H a0 a23 a31 a12) == (BV b23 b31 b12) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12+ (C a0 a123) == (BV b23 b31 b12) = a0 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12+ (ODD a1 a2 a3 a123) == (BV b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (TPV a23 a31 a12 a123) == (BV b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (BV b23 b31 b12) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0++ (I a123) == (I b123) = a123 == b123++ (I a123) == (PV b0 b1 b2 b3) = a123 == 0 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (I a123) == (H b0 b23 b31 b12) = a123 == 0 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (I a123) == (C b0 b123) = a123 == b123 && b0 == 0+ (I a123) == (BPV b1 b2 b3 b23 b31 b12) = a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (I a123) == (ODD b1 b2 b3 b123) = a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0+ (I a123) == (TPV b23 b31 b12 b123) = a123 == b123 && b23 == 0 && b31 == 0 && b12 == 0+ (I a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a123 == b123 && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0++ (PV a0 a1 a2 a3) == (I b123) = b123 == 0 && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0+ (H a0 a23 a31 a12) == (I b123) = b123 == 0 && a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0+ (C a0 a123) == (I b123) = a123 == b123 && a0 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (I b123) = b123 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0+ (ODD a1 a2 a3 a123) == (I b123) = a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0+ (TPV a23 a31 a12 a123) == (I b123) = a123 == b123 && a23 == 0 && a31 == 0 && a12 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (I b123) = a123 == b123 && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0++ (PV a0 a1 a2 a3) == (PV b0 b1 b2 b3) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3++ (PV a0 a1 a2 a3) == (H b0 b23 b31 b12) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (PV a0 a1 a2 a3) == (C b0 b123) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && b123 == 0+ (PV a0 a1 a2 a3) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0+ (PV a0 a1 a2 a3) == (ODD b1 b2 b3 b123) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0+ (PV a0 a1 a2 a3) == (TPV b23 b31 b12 b123) = a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0+ (PV a0 a1 a2 a3) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && b23 == 0 && b31 == 0 && b12 == 0 && b123 == 0++ (H a0 a23 a31 a12) == (PV b0 b1 b2 b3) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (C a0 a123) == (PV b0 b1 b2 b3) = a0 == b0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0+ (ODD a1 a2 a3 a123) == (PV b0 b1 b2 b3) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0 && b0 == 0+ (TPV a23 a31 a12 a123) == (PV b0 b1 b2 b3) = a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (PV b0 b1 b2 b3) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == 0 && a31 == 0 && a12 == 0 && a123 == 0++ (H a0 a23 a31 a12) == (H b0 b23 b31 b12) = a0 == b0 && a23 == b23 && a31 == b31 && a12 == b12++ (H a0 a23 a31 a12) == (C b0 b123) = a0 == b0 && a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0+ (H a0 a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0+ (H a0 a23 a31 a12) == (ODD b1 b2 b3 b123) = a0 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b123 == 0+ (H a0 a23 a31 a12) == (TPV b23 b31 b12 b123) = a0 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0+ (H a0 a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a23 == b23 && a31 == b31 && a12 == b12 && b1 == 0 && b2 == 0 && b3 == 0 && b123 == 0++ (C a0 a123) == (H b0 b23 b31 b12) = a0 == b0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0+ (ODD a1 a2 a3 a123) == (H b0 b23 b31 b12) = a1 == 0 && a2 == 0 && a3 == 0 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0 && b0 == 0+ (TPV a23 a31 a12 a123) == (H b0 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && b0 == 0 && a123 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (H b0 b23 b31 b12) = a0 == b0 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0++ (C a0 a123) == (C b0 b123) = a0 == b0 && a123 == b123++ (C a0 a123) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (C a0 a123) == (ODD b1 b2 b3 b123) = a0 == 0 && a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0+ (C a0 a123) == (TPV b23 b31 b12 b123) = a0 == 0 && a123 == b123 && b23 == 0 && b31 == 0 && b12 == 0+ (C a0 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0 && b23 == 0 && b31 == 0 && b12 == 0++ (BPV a1 a2 a3 a23 a31 a12) == (C b0 b123) = a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0 && b0 == 0 && b123 == 0+ (ODD a1 a2 a3 a123) == (C b0 b123) = b0 == 0 && a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0+ (TPV a23 a31 a12 a123) == (C b0 b123) = b0 == 0 && a123 == b123 && a23 == 0 && a31 == 0 && a12 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (C b0 b123) = a0 == b0 && a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0 && a23 == 0 && a31 == 0 && a12 == 0++ (BPV a1 a2 a3 a23 a31 a12) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31 && a12 == b12++ (BPV a1 a2 a3 a23 a31 a12) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && b123 == 0 && a23 == 0 && a31 == 0 && a12 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && b123 == 0 && a1 == 0 && a2 == 0 && a3 == 0+ (BPV a1 a2 a3 a23 a31 a12) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31 && a12 == b12+ && b0 == 0 && b123 == 0++ (ODD a1 a2 a3 a123) == (BPV b1 b2 b3 b23 b31 b12) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (TPV a23 a31 a12 a123) == (BPV b1 b2 b3 b23 b31 b12) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == 0 && b1 == 0 && b2 == 0 && b3 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (BPV b1 b2 b3 b23 b31 b12) = a0 == 0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23 && a31 == b31+ && a12 == b12 && a123 == 0++ (ODD a1 a2 a3 a123) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123++ (ODD a1 a2 a3 a123) == (TPV b23 b31 b12 b123) = a123 == b123 && a1 == 0 && a2 == 0 && a3 == 0 && b23 == 0 && b31 == 0 && b12 == 0+ (ODD a1 a2 a3 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123 && b0 == 0 && b23 == 0 && b31 == 0 && b12 == 0++ (TPV a23 a31 a12 a123) == (ODD b1 b2 b3 b123) = a123 == b123 && b1 == 0 && b2 == 0 && b3 == 0 && a23 == 0 && a31 == 0 && a12 == 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (ODD b1 b2 b3 b123) = a1 == b1 && a2 == b2 && a3 == b3 && a123 == b123 && a0 == 0 && a23 == 0 && a31 == 0 && a12 == 0++ (TPV a23 a31 a12 a123) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123++ (TPV a23 a31 a12 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123+ && b0 == 0 && b1 == 0 && b2 == 0 && b3 == 0++ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (TPV b23 b31 b12 b123) = a23 == b23 && a31 == b31 && a12 == b12 && a123 == b123+ && a0 == 0 && a1 == 0 && a2 == 0 && a3 == 0++ (APS a0 a1 a2 a3 a23 a31 a12 a123) == (APS b0 b1 b2 b3 b23 b31 b12 b123) = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && a23 == b23+ && a31 == b31 && a12 == b12 && a123 == b123+++-- |Cl3 has a total preorder ordering in which all pairs are comparable by two real valued functions.+-- Comparison of two reals is just the typical real compare function. Comparison of to imaginary numbers+-- is just the typical comparison function. When reals are compared to anything else it will compare the+-- absolute value of the reals to the magnitude of the other cliffor. Compare of two complex values+-- compares the polar magnitude of the complex numbers. Compare of two vectors compares the vector+-- magnitudes. The Ord instance for the general case is based on the singular values of each cliffor and+-- this Ordering compares the largest singular value 'abs' and then the littlest singular value 'lsv'.+-- Some arbitrary cliffors may return EQ for Ord but not be exactly '==' equivalent, but they are related+-- by a right and left multiplication of two unitary elements. For instance for the Cliffors A and B,+-- A == B could be False, but compare A B is EQ, because A * V = U * B, where V and U are unitary. +instance Ord Cl3 where+ compare (R a0) (R b0) = compare a0 b0 -- Real Numbers have a total order within the limitations of Double Precision comparison+ compare (I a123) (I b123) = compare a123 b123 -- Imaginary Numbers have a total order within the limitations of Double Precision comparison+ compare cliffor1 cliffor2 =+ let (R a0) = abs cliffor1+ (R b0) = abs cliffor2+ (R a0') = lsv cliffor1+ (R b0') = lsv cliffor2+ in case compare a0 b0 of+ LT -> LT+ GT -> GT+ EQ -> compare a0' b0'++++-- |Cl3 has a "Num" instance. "Num" is addition, geometric product, negation, 'abs' the largest+-- singular value, and 'signum'.+-- +instance Num Cl3 where+ -- | Cl3 can be added+ (R a0) + (R b0) = R (a0 + b0)++ (R a0) + (V3 b1 b2 b3) = PV a0 b1 b2 b3+ (R a0) + (BV b23 b31 b12) = H a0 b23 b31 b12+ (R a0) + (I b123) = C a0 b123+ (R a0) + (PV b0 b1 b2 b3) = PV (a0 + b0) b1 b2 b3+ (R a0) + (H b0 b23 b31 b12) = H (a0 + b0) b23 b31 b12+ (R a0) + (C b0 b123) = C (a0 + b0) b123+ (R a0) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 b23 b31 b12 0+ (R a0) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 0 0 0 b123+ (R a0) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 b23 b31 b12 b123+ (R a0) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 b23 b31 b12 b123++ (V3 a1 a2 a3) + (R b0) = PV b0 a1 a2 a3+ (BV a23 a31 a12) + (R b0) = H b0 a23 a31 a12+ (I a123) + (R b0) = C b0 a123+ (PV a0 a1 a2 a3) + (R b0) = PV (a0 + b0) a1 a2 a3+ (H a0 a23 a31 a12) + (R b0) = H (a0 + b0) a23 a31 a12+ (C a0 a123) + (R b0) = C (a0 + b0) a123+ (BPV a1 a2 a3 a23 a31 a12) + (R b0) = APS b0 a1 a2 a3 a23 a31 a12 0+ (ODD a1 a2 a3 a123) + (R b0) = APS b0 a1 a2 a3 0 0 0 a123+ (TPV a23 a31 a12 a123) + (R b0) = APS b0 0 0 0 a23 a31 a12 a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (R b0) = APS (a0 + b0) a1 a2 a3 a23 a31 a12 a123++ (V3 a1 a2 a3) + (V3 b1 b2 b3) = V3 (a1 + b1) (a2 + b2) (a3 + b3)++ (V3 a1 a2 a3) + (BV b23 b31 b12) = BPV a1 a2 a3 b23 b31 b12+ (V3 a1 a2 a3) + (I b123) = ODD a1 a2 a3 b123+ (V3 a1 a2 a3) + (PV b0 b1 b2 b3) = PV b0 (a1 + b1) (a2 + b2) (a3 + b3)+ (V3 a1 a2 a3) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 b23 b31 b12 0+ (V3 a1 a2 a3) + (C b0 b123) = APS b0 a1 a2 a3 0 0 0 b123+ (V3 a1 a2 a3) + (BPV b1 b2 b3 b23 b31 b12) = BPV (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12+ (V3 a1 a2 a3) + (ODD b1 b2 b3 b123) = ODD (a1 + b1) (a2 + b2) (a3 + b3) b123+ (V3 a1 a2 a3) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 b23 b31 b12 b123+ (V3 a1 a2 a3) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 b123++ (BV a23 a31 a12) + (V3 b1 b2 b3) = BPV b1 b2 b3 a23 a31 a12+ (I a123) + (V3 b1 b2 b3) = ODD b1 b2 b3 a123+ (PV a0 a1 a2 a3) + (V3 b1 b2 b3) = PV a0 (a1 + b1) (a2 + b2) (a3 + b3)+ (H a0 a23 a31 a12) + (V3 b1 b2 b3) = APS a0 b1 b2 b3 a23 a31 a12 0+ (C a0 a123) + (V3 b1 b2 b3) = APS a0 b1 b2 b3 0 0 0 a123+ (BPV a1 a2 a3 a23 a31 a12) + (V3 b1 b2 b3) = BPV (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12+ (ODD a1 a2 a3 a123) + (V3 b1 b2 b3) = ODD (a1 + b1) (a2 + b2) (a3 + b3) a123+ (TPV a23 a31 a12 a123) + (V3 b1 b2 b3) = APS 0 b1 b2 b3 a23 a31 a12 a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (V3 b1 b2 b3) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 a123++ (BV a23 a31 a12) + (BV b23 b31 b12) = BV (a23 + b23) (a31 + b31) (a12 + b12)++ (BV a23 a31 a12) + (I b123) = TPV a23 a31 a12 b123+ (BV a23 a31 a12) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 a23 a31 a12 0+ (BV a23 a31 a12) + (H b0 b23 b31 b12) = H b0 (a23 + b23) (a31 + b31) (a12 + b12)+ (BV a23 a31 a12) + (C b0 b123) = APS b0 0 0 0 a23 a31 a12 b123+ (BV a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = BPV b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12)+ (BV a23 a31 a12) + (ODD b1 b2 b3 b123) = APS 0 b1 b2 b3 a23 a31 a12 b123+ (BV a23 a31 a12) + (TPV b23 b31 b12 b123) = TPV (a23 + b23) (a31 + b31) (a12 + b12) b123+ (BV a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) b123++ (I a123) + (BV b23 b31 b12) = TPV b23 b31 b12 a123+ (PV a0 a1 a2 a3) + (BV b23 b31 b12) = APS a0 a1 a2 a3 b23 b31 b12 0+ (H a0 a23 a31 a12) + (BV b23 b31 b12) = H a0 (a23 + b23) (a31 + b31) (a12 + b12)+ (C a0 a123) + (BV b23 b31 b12) = APS a0 0 0 0 b23 b31 b12 a123+ (BPV a1 a2 a3 a23 a31 a12) + (BV b23 b31 b12) = BPV a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12)+ (ODD a1 a2 a3 a123) + (BV b23 b31 b12) = APS 0 a1 a2 a3 b23 b31 b12 a123+ (TPV a23 a31 a12 a123) + (BV b23 b31 b12) = TPV (a23 + b23) (a31 + b31) (a12 + b12) a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (BV b23 b31 b12) = APS a0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) a123++ (I a123) + (I b123) = I (a123 + b123)++ (I a123) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 0 0 0 a123+ (I a123) + (H b0 b23 b31 b12) = APS b0 0 0 0 b23 b31 b12 a123+ (I a123) + (C b0 b123) = C b0 (a123 + b123)+ (I a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 b1 b2 b3 b23 b31 b12 a123+ (I a123) + (ODD b1 b2 b3 b123) = ODD b1 b2 b3 (a123 + b123)+ (I a123) + (TPV b23 b31 b12 b123) = TPV b23 b31 b12 (a123 + b123)+ (I a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 b23 b31 b12 (a123 + b123)++ (PV a0 a1 a2 a3) + (I b123) = APS a0 a1 a2 a3 0 0 0 b123+ (H a0 a23 a31 a12) + (I b123) = APS a0 0 0 0 a23 a31 a12 b123+ (C a0 a123) + (I b123) = C a0 (a123 + b123)+ (BPV a1 a2 a3 a23 a31 a12) + (I b123) = APS 0 a1 a2 a3 a23 a31 a12 b123+ (ODD a1 a2 a3 a123) + (I b123) = ODD a1 a2 a3 (a123 + b123)+ (TPV a23 a31 a12 a123) + (I b123) = TPV a23 a31 a12 (a123 + b123)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (I b123) = APS a0 a1 a2 a3 a23 a31 a12 (a123 + b123)++ (PV a0 a1 a2 a3) + (PV b0 b1 b2 b3) = PV (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3)++ (PV a0 a1 a2 a3) + (H b0 b23 b31 b12) = APS (a0 + b0) a1 a2 a3 b23 b31 b12 0+ (PV a0 a1 a2 a3) + (C b0 b123) = APS (a0 + b0) a1 a2 a3 0 0 0 b123+ (PV a0 a1 a2 a3) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 0+ (PV a0 a1 a2 a3) + (ODD b1 b2 b3 b123) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) 0 0 0 b123+ (PV a0 a1 a2 a3) + (TPV b23 b31 b12 b123) = APS a0 a1 a2 a3 b23 b31 b12 b123+ (PV a0 a1 a2 a3) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 b123++ (H a0 a23 a31 a12) + (PV b0 b1 b2 b3) = APS (a0 + b0) b1 b2 b3 a23 a31 a12 0+ (C a0 a123) + (PV b0 b1 b2 b3) = APS (a0 + b0) b1 b2 b3 0 0 0 a123+ (BPV a1 a2 a3 a23 a31 a12) + (PV b0 b1 b2 b3) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 0+ (ODD a1 a2 a3 a123) + (PV b0 b1 b2 b3) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) 0 0 0 a123+ (TPV a23 a31 a12 a123) + (PV b0 b1 b2 b3) = APS b0 b1 b2 b3 a23 a31 a12 a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (PV b0 b1 b2 b3) = APS (a0 + b0) (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 a123++ (H a0 a23 a31 a12) + (H b0 b23 b31 b12) = H (a0 + b0) (a23 + b23) (a31 + b31) (a12 + b12)++ (H a0 a23 a31 a12) + (C b0 b123) = APS (a0 + b0) 0 0 0 a23 a31 a12 b123+ (H a0 a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) 0+ (H a0 a23 a31 a12) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 a23 a31 a12 b123+ (H a0 a23 a31 a12) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 (a23 + b23) (a31 + b31) (a12 + b12) b123+ (H a0 a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) b123++ (C a0 a123) + (H b0 b23 b31 b12) = APS (a0 + b0) 0 0 0 b23 b31 b12 a123+ (BPV a1 a2 a3 a23 a31 a12) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) 0+ (ODD a1 a2 a3 a123) + (H b0 b23 b31 b12) = APS b0 a1 a2 a3 b23 b31 b12 a123+ (TPV a23 a31 a12 a123) + (H b0 b23 b31 b12) = APS b0 0 0 0 (a23 + b23) (a31 + b31) (a12 + b12) a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (H b0 b23 b31 b12) = APS (a0 + b0) a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) a123++ (C a0 a123) + (C b0 b123) = C (a0 + b0) (a123 + b123)++ (C a0 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 b1 b2 b3 b23 b31 b12 a123+ (C a0 a123) + (ODD b1 b2 b3 b123) = APS a0 b1 b2 b3 0 0 0 (a123 + b123)+ (C a0 a123) + (TPV b23 b31 b12 b123) = APS a0 0 0 0 b23 b31 b12 (a123 + b123)+ (C a0 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0) b1 b2 b3 b23 b31 b12 (a123 + b123)++ (BPV a1 a2 a3 a23 a31 a12) + (C b0 b123) = APS b0 a1 a2 a3 a23 a31 a12 b123+ (ODD a1 a2 a3 a123) + (C b0 b123) = APS b0 a1 a2 a3 0 0 0 (a123 + b123)+ (TPV a23 a31 a12 a123) + (C b0 b123) = APS b0 0 0 0 a23 a31 a12 (a123 + b123)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (C b0 b123) = APS (a0 + b0) a1 a2 a3 a23 a31 a12 (a123 + b123)++ (BPV a1 a2 a3 a23 a31 a12) + (BPV b1 b2 b3 b23 b31 b12) = BPV (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12)++ (BPV a1 a2 a3 a23 a31 a12) + (ODD b1 b2 b3 b123) = APS 0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 b123+ (BPV a1 a2 a3 a23 a31 a12) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) b123+ (BPV a1 a2 a3 a23 a31 a12) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12) b123++ (ODD a1 a2 a3 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 a123+ (TPV a23 a31 a12 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS 0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) a123+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (BPV b1 b2 b3 b23 b31 b12) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) (a23 + b23) (a31 + b31) (a12 + b12) a123++ (ODD a1 a2 a3 a123) + (ODD b1 b2 b3 b123) = ODD (a1 + b1) (a2 + b2) (a3 + b3) (a123 + b123)++ (ODD a1 a2 a3 a123) + (TPV b23 b31 b12 b123) = APS 0 a1 a2 a3 b23 b31 b12 (a123 + b123)+ (ODD a1 a2 a3 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 (a1 + b1) (a2 + b2) (a3 + b3) b23 b31 b12 (a123 + b123)++ (TPV a23 a31 a12 a123) + (ODD b1 b2 b3 b123) = APS 0 b1 b2 b3 a23 a31 a12 (a123 + b123)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (ODD b1 b2 b3 b123) = APS a0 (a1 + b1) (a2 + b2) (a3 + b3) a23 a31 a12 (a123 + b123)++ (TPV a23 a31 a12 a123) + (TPV b23 b31 b12 b123) = TPV (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)++ (TPV a23 a31 a12 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS b0 b1 b2 b3 (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)++ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (TPV b23 b31 b12 b123) = APS a0 a1 a2 a3 (a23 + b23) (a31 + b31) (a12 + b12) (a123 + b123)++ (APS a0 a1 a2 a3 a23 a31 a12 a123) + (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0 + b0)+ (a1 + b1) (a2 + b2) (a3 + b3)+ (a23 + b23) (a31 + b31) (a12 + b12)+ (a123 + b123)++ -- | Multiplication Instance implementing a Geometric Product+ (R a0) * (R b0) = R (a0*b0)++ (R a0) * (V3 b1 b2 b3) = V3 (a0*b1) (a0*b2) (a0*b3)+ (R a0) * (BV b23 b31 b12) = BV (a0*b23) (a0*b31) (a0*b12)+ (R a0) * (I b123) = I (a0*b123)+ (R a0) * (PV b0 b1 b2 b3) = PV (a0*b0)+ (a0*b1) (a0*b2) (a0*b3)+ (R a0) * (H b0 b23 b31 b12) = H (a0*b0)+ (a0*b23) (a0*b31) (a0*b12)+ (R a0) * (C b0 b123) = C (a0*b0)+ (a0*b123)+ (R a0) * (BPV b1 b2 b3 b23 b31 b12) = BPV (a0*b1) (a0*b2) (a0*b3)+ (a0*b23) (a0*b31) (a0*b12)+ (R a0) * (ODD b1 b2 b3 b123) = ODD (a0*b1) (a0*b2) (a0*b3)+ (a0*b123)+ (R a0) * (TPV b23 b31 b12 b123) = TPV (a0*b23) (a0*b31) (a0*b12)+ (a0*b123)+ (R a0) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0)+ (a0*b1) (a0*b2) (a0*b3)+ (a0*b23) (a0*b31) (a0*b12)+ (a0*b123)++ (V3 a1 a2 a3) * (R b0) = V3 (a1*b0) (a2*b0) (a3*b0)+ (BV a23 a31 a12) * (R b0) = BV (a23*b0) (a31*b0) (a12*b0)+ (I a123) * (R b0) = I (a123*b0)+ (PV a0 a1 a2 a3) * (R b0) = PV (a0*b0)+ (a1*b0) (a2*b0) (a3*b0)+ (H a0 a23 a31 a12) * (R b0) = H (a0*b0)+ (a23*b0) (a31*b0) (a12*b0)+ (C a0 a123) * (R b0) = C (a0*b0)+ (a123*b0)+ (BPV a1 a2 a3 a23 a31 a12) * (R b0) = BPV (a1*b0) (a2*b0) (a3*b0)+ (a23*b0) (a31*b0) (a12*b0)+ (ODD a1 a2 a3 a123) * (R b0) = ODD (a1*b0) (a2*b0) (a3*b0)+ (a123*b0)+ (TPV a23 a31 a12 a123) * (R b0) = TPV (a23*b0) (a31*b0) (a12*b0)+ (a123*b0)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (R b0) = APS (a0*b0)+ (a1*b0) (a2*b0) (a3*b0)+ (a23*b0) (a31*b0) (a12*b0)+ (a123*b0)++ (V3 a1 a2 a3) * (V3 b1 b2 b3) = H (a1*b1 + a2*b2 + a3*b3)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)++ (V3 a1 a2 a3) * (BV b23 b31 b12) = ODD (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)+ (a1*b23 + a2*b31 + a3*b12)+ (V3 a1 a2 a3) * (I b123) = BV (a1*b123) (a2*b123) (a3*b123)+ (V3 a1 a2 a3) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a1*b0) (a2*b0) (a3*b0)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)+ 0+ (V3 a1 a2 a3) * (H b0 b23 b31 b12) = ODD (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)+ (a1*b23 + a2*b31 + a3*b12)+ (V3 a1 a2 a3) * (C b0 b123) = BPV (a1*b0) (a2*b0) (a3*b0)+ (a1*b123) (a2*b123) (a3*b123)+ (V3 a1 a2 a3) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)+ (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)+ (a1*b23 + a2*b31 + a3*b12)+ (V3 a1 a2 a3) * (ODD b1 b2 b3 b123) = H (a1*b1 + a2*b2 + a3*b3)+ (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)+ (V3 a1 a2 a3) * (TPV b23 b31 b12 b123) = APS 0+ (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)+ (a1*b123) (a2*b123) (a3*b123)+ (a1*b23 + a2*b31 + a3*b12)+ (V3 a1 a2 a3) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3)+ (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)+ (a1*b123 + a2*b3 - a3*b2) (a3*b1 - a1*b3 + a2*b123) (a1*b2 - a2*b1 + a3*b123)+ (a1*b23 + a2*b31 + a3*b12)++ (BV a23 a31 a12) * (V3 b1 b2 b3) = ODD (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)+ (a23*b1 + a31*b2 + a12*b3)+ (I a123) * (V3 b1 b2 b3) = BV (a123*b1) (a123*b2) (a123*b3)+ (PV a0 a1 a2 a3) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a0*b1) (a0*b2) (a0*b3)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)+ 0+ (H a0 a23 a31 a12) * (V3 b1 b2 b3) = ODD (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)+ (a23*b1 + a31*b2 + a12*b3)+ (C a0 a123) * (V3 b1 b2 b3) = BPV (a0*b1) (a0*b2) (a0*b3)+ (a123*b1) (a123*b2) (a123*b3)+ (BPV a1 a2 a3 a23 a31 a12) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)+ (a23*b1 + a31*b2 + a12*b3)+ (ODD a1 a2 a3 a123) * (V3 b1 b2 b3) = H (a1*b1 + a2*b2 + a3*b3)+ (a123*b1 + a2*b3 - a3*b2) (a123*b2 - a1*b3 + a3*b1) (a123*b3 + a1*b2 - a2*b1)+ (TPV a23 a31 a12 a123) * (V3 b1 b2 b3) = APS 0+ (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)+ (a123*b1) (a123*b2) (a123*b3)+ (a23*b1 + a31*b2 + a12*b3)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (V3 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)+ (a123*b1 + a2*b3 - a3*b2) (a3*b1 - a1*b3 + a123*b2) (a1*b2 - a2*b1 + a123*b3)+ (a23*b1 + a31*b2 + a12*b3)++ (BV a23 a31 a12) * (BV b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)+ (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)++ (BV a23 a31 a12) * (I b123) = V3 (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (BV a23 a31 a12) * (PV b0 b1 b2 b3) = APS 0+ (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)+ (a23*b0) (a31*b0) (a12*b0)+ (a23*b1 + a31*b2 + a12*b3)+ (BV a23 a31 a12) * (H b0 b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)+ (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)+ (BV a23 a31 a12) * (C b0 b123) = BPV (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a23*b0) (a31*b0) (a12*b0)+ (BV a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2) + (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)+ (a23*b1 + a31*b2 + a12*b3)+ (BV a23 a31 a12) * (ODD b1 b2 b3 b123) = ODD (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)+ (a23*b1 + a31*b2 + a12*b3)+ (BV a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)+ 0+ (BV a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a31*b123 - a12*b1) (a31*b1 - a23*b2 - a12*b123)+ (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)+ (a23*b1 + a31*b2 + a12*b3)++ (I a123) * (BV b23 b31 b12) = V3 (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (PV a0 a1 a2 a3) * (BV b23 b31 b12) = APS 0+ (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)+ (a0*b23) (a0*b31) (a0*b12)+ (a1*b23 + a2*b31 + a3*b12)+ (H a0 a23 a31 a12) * (BV b23 b31 b12) = H (negate $ a23*b23 + a31*b31 + a12*b12)+ (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)+ (C a0 a123) * (BV b23 b31 b12) = BPV (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a0*b23) (a0*b31) (a0*b12)+ (BPV a1 a2 a3 a23 a31 a12) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31) + (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)+ (a1*b23 + a2*b31 + a3*b12)+ (ODD a1 a2 a3 a123) * (BV b23 b31 b12) = ODD (negate $ a123*b23 + a2*b12 - a3*b31)+ (negate $ a123*b31 - a1*b12 + a3*b23)+ (negate $ a123*b12 + a1*b31 - a2*b23)+ (a1*b23 + a2*b31 + a3*b12)+ (TPV a23 a31 a12 a123) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (negate $ a31*b12 - a12*b31) (negate $ a12*b23 - a23*b12) (negate $ a23*b31 - a31*b23)+ 0+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (BV b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12) + (a3*b31 - a123*b23 - a2*b12) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a123*b12 - a1*b31)+ (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)+ (a1*b23 + a2*b31 + a3*b12)++ (I a123) * (I b123) = R (negate $ a123*b123)++ (I a123) * (PV b0 b1 b2 b3) = TPV (a123*b1) (a123*b2) (a123*b3)+ (a123*b0)+ (I a123) * (H b0 b23 b31 b12) = ODD (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a123*b0)+ (I a123) * (C b0 b123) = C (negate $ a123*b123)+ (a123*b0)+ (I a123) * (BPV b1 b2 b3 b23 b31 b12) = BPV (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a123*b1) (a123*b2) (a123*b3)+ (I a123) * (ODD b1 b2 b3 b123) = H (negate $ a123*b123)+ (a123*b1) (a123*b2) (a123*b3)+ (I a123) * (TPV b23 b31 b12 b123) = PV (negate $ a123*b123)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (I a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a123*b123)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a123*b1) (a123*b2) (a123*b3)+ (a123*b0)++ (PV a0 a1 a2 a3) * (I b123) = TPV (a1*b123) (a2*b123) (a3*b123)+ (a0*b123)+ (H a0 a23 a31 a12) * (I b123) = ODD (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a0*b123)+ (C a0 a123) * (I b123) = C (negate $ a123*b123)+ (a0*b123)+ (BPV a1 a2 a3 a23 a31 a12) * (I b123) = BPV (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a1*b123) (a2*b123) (a3*b123)+ (ODD a1 a2 a3 a123) * (I b123) = H (negate $ a123*b123)+ (a1*b123) (a2*b123) (a3*b123)+ (TPV a23 a31 a12 a123) * (I b123) = PV (negate $ a123*b123)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (I b123) = APS (negate $ a123*b123)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a1*b123) (a2*b123) (a3*b123)+ (a0*b123)+++ (PV a0 a1 a2 a3) * (PV b0 b1 b2 b3) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)+ (a0*b1 + a1*b0) (a0*b2 + a2*b0) (a0*b3 + a3*b0)+ (a2*b3 - a3*b2) (a3*b1 - a1*b3) (a1*b2 - a2*b1)+ 0++ (PV a0 a1 a2 a3) * (H b0 b23 b31 b12) = APS (a0*b0)+ (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)+ (a0*b23) (a0*b31) (a0*b12)+ (a1*b23 + a2*b31 + a3*b12)+ (PV a0 a1 a2 a3) * (C b0 b123) = APS (a0*b0)+ (a1*b0) (a2*b0) (a3*b0)+ (a1*b123) (a2*b123) (a3*b123)+ (a0*b123)+ (PV a0 a1 a2 a3) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)+ (a0*b1 - a2*b12 + a3*b31) (a0*b2 + a1*b12 - a3*b23) (a0*b3 - a1*b31 + a2*b23)+ (a0*b23 + a2*b3 - a3*b2) (a0*b31 - a1*b3 + a3*b1) (a0*b12 + a1*b2 - a2*b1)+ (a1*b23 + a2*b31 + a3*b12)+ (PV a0 a1 a2 a3) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3)+ (a0*b1) (a0*b2) (a0*b3)+ (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)+ (a0*b123)+ (PV a0 a1 a2 a3) * (TPV b23 b31 b12 b123) = APS 0+ (a3*b31 - a2*b12) (a1*b12 - a3*b23) (a2*b23 - a1*b31)+ (a0*b23 + a1*b123) (a0*b31 + a2*b123) (a0*b12 + a3*b123)+ (a0*b123 + a1*b23 + a2*b31 + a3*b12)+ (PV a0 a1 a2 a3) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)+ (a0*b1 + a1*b0 - a2*b12 + a3*b31)+ (a0*b2 + a2*b0 + a1*b12 - a3*b23)+ (a0*b3 + a3*b0 - a1*b31 + a2*b23)+ (a0*b23 + a1*b123 + a2*b3 - a3*b2)+ (a0*b31 - a1*b3 + a3*b1 + a2*b123)+ (a0*b12 + a1*b2 - a2*b1 + a3*b123)+ (a0*b123 + a1*b23 + a2*b31 + a3*b12)++ (H a0 a23 a31 a12) * (PV b0 b1 b2 b3) = APS (a0*b0)+ (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)+ (a23*b0) (a31*b0) (a12*b0)+ (a23*b1 + a31*b2 + a12*b3)+ (C a0 a123) * (PV b0 b1 b2 b3) = APS (a0*b0)+ (a0*b1) (a0*b2) (a0*b3)+ (a123*b1) (a123*b2) (a123*b3)+ (a123*b0)+ (BPV a1 a2 a3 a23 a31 a12) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a1*b0 + a12*b2 - a31*b3) (a2*b0 - a12*b1 + a23*b3) (a3*b0 + a31*b1 - a23*b2)+ (a23*b0 + a2*b3 - a3*b2) (a31*b0 - a1*b3 + a3*b1) (a12*b0 + a1*b2 - a2*b1)+ (a23*b1 + a31*b2 + a12*b3)+ (ODD a1 a2 a3 a123) * (PV b0 b1 b2 b3) = APS (a1*b1 + a2*b2 + a3*b3)+ (a1*b0) (a2*b0) (a3*b0)+ (a123*b1 + a2*b3 - a3*b2)+ (a123*b2 - a1*b3 + a3*b1)+ (a123*b3 + a1*b2 - a2*b1)+ (a123*b0)+ (TPV a23 a31 a12 a123) * (PV b0 b1 b2 b3) = APS 0+ (a12*b2 - a31*b3) (a23*b3 - a12*b1) (a31*b1 - a23*b2)+ (a23*b0 + a123*b1) (a31*b0 + a123*b2) (a12*b0 + a123*b3)+ (a123*b0 + a23*b1 + a31*b2 + a12*b3)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (PV b0 b1 b2 b3) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3)+ (a0*b1 + a1*b0 + a12*b2 - a31*b3)+ (a0*b2 + a2*b0 - a12*b1 + a23*b3)+ (a0*b3 + a3*b0 + a31*b1 - a23*b2)+ (a23*b0 + a123*b1 + a2*b3 - a3*b2)+ (a31*b0 - a1*b3 + a3*b1 + a123*b2)+ (a12*b0 + a1*b2 - a2*b1 + a123*b3)+ (a123*b0 + a23*b1 + a31*b2 + a12*b3)++ (H a0 a23 a31 a12) * (H b0 b23 b31 b12) = H (a0*b0 - a23*b23 - a31*b31 - a12*b12)+ (a0*b23 + a23*b0 - a31*b12 + a12*b31)+ (a0*b31 + a31*b0 + a23*b12 - a12*b23)+ (a0*b12 + a12*b0 - a23*b31 + a31*b23)++ (H a0 a23 a31 a12) * (C b0 b123) = APS (a0*b0)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a23*b0) (a31*b0) (a12*b0)+ (a0*b123)+ (H a0 a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a0*b1 + a12*b2 - a31*b3) (a0*b2 - a12*b1 + a23*b3) (a0*b3 + a31*b1 - a23*b2)+ (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)+ (a23*b1 + a31*b2 + a12*b3)+ (H a0 a23 a31 a12) * (ODD b1 b2 b3 b123) = ODD (a0*b1 + a12*b2 - a31*b3 - a23*b123)+ (a0*b2 - a12*b1 + a23*b3 - a31*b123)+ (a0*b3 + a31*b1 - a23*b2 - a12*b123)+ (a0*b123 + a23*b1 + a31*b2 + a12*b3)+ (H a0 a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a0*b23 - a31*b12 + a12*b31) (a0*b31 + a23*b12 - a12*b23) (a0*b12 - a23*b31 + a31*b23)+ (a0*b123)+ (H a0 a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 - a23*b23 - a31*b31 - a12*b12)+ (a0*b1 + a12*b2 - a31*b3 - a23*b123)+ (a0*b2 - a12*b1 + a23*b3 - a31*b123)+ (a0*b3 + a31*b1 - a23*b2 - a12*b123)+ (a0*b23 + a23*b0 - a31*b12 + a12*b31)+ (a0*b31 + a31*b0 + a23*b12 - a12*b23)+ (a0*b12 + a12*b0 - a23*b31 + a31*b23)+ (a0*b123 + a23*b1 + a31*b2 + a12*b3)++ (C a0 a123) * (H b0 b23 b31 b12) = APS (a0*b0)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a0*b23) (a0*b31) (a0*b12)+ (a123*b0)+ (BPV a1 a2 a3 a23 a31 a12) * (H b0 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a1*b0 - a2*b12 + a3*b31) (a2*b0 + a1*b12 - a3*b23) (a3*b0 - a1*b31 + a2*b23)+ (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)+ (a1*b23 + a2*b31 + a3*b12)+ (ODD a1 a2 a3 a123) * (H b0 b23 b31 b12) = ODD (a1*b0 - a2*b12 + a3*b31 - a123*b23)+ (a2*b0 + a1*b12 - a3*b23 - a123*b31)+ (a3*b0 - a1*b31 + a2*b23 - a123*b12)+ (a123*b0 + a1*b23 + a2*b31 + a3*b12)+ (TPV a23 a31 a12 a123) * (H b0 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a23*b0 - a31*b12 + a12*b31) (a31*b0 + a23*b12 - a12*b23) (a12*b0 - a23*b31 + a31*b23)+ (a123*b0)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (H b0 b23 b31 b12) = APS (a0*b0 - a23*b23 - a31*b31 - a12*b12)+ (a1*b0 - a2*b12 + a3*b31 - a123*b23)+ (a2*b0 + a1*b12 - a3*b23 - a123*b31)+ (a3*b0 - a1*b31 + a2*b23 - a123*b12)+ (a0*b23 + a23*b0 - a31*b12 + a12*b31)+ (a0*b31 + a31*b0 + a23*b12 - a12*b23)+ (a0*b12 + a12*b0 - a23*b31 + a31*b23)+ (a123*b0 + a1*b23 + a2*b31 + a3*b12)++ (C a0 a123) * (C b0 b123) = C (a0*b0 - a123*b123)+ (a0*b123 + a123*b0)++ (C a0 a123) * (BPV b1 b2 b3 b23 b31 b12) = BPV (a0*b1 - a123*b23) (a0*b2 - a123*b31) (a0*b3 - a123*b12)+ (a0*b23 + a123*b1) (a0*b31 + a123*b2) (a0*b12 + a123*b3)+ (C a0 a123) * (ODD b1 b2 b3 b123) = APS (negate $ a123*b123)+ (a0*b1) (a0*b2) (a0*b3)+ (a123*b1) (a123*b2) (a123*b3)+ (a0*b123)+ (C a0 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a123*b123)+ (negate $ a123*b23) (negate $ a123*b31) (negate $ a123*b12)+ (a0*b23) (a0*b31) (a0*b12)+ (a0*b123)+ (C a0 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 - a123*b123)+ (a0*b1 - a123*b23) (a0*b2 - a123*b31) (a0*b3 - a123*b12)+ (a0*b23 + a123*b1) (a0*b31 + a123*b2) (a0*b12 + a123*b3)+ (a0*b123 + a123*b0)++ (BPV a1 a2 a3 a23 a31 a12) * (C b0 b123) = BPV (a1*b0 - a23*b123) (a2*b0 - a31*b123) (a3*b0 - a12*b123)+ (a23*b0 + a1*b123) (a31*b0 + a2*b123) (a12*b0 + a3*b123)+ (ODD a1 a2 a3 a123) * (C b0 b123) = APS (negate $ a123*b123)+ (a1*b0) (a2*b0) (a3*b0)+ (a1*b123) (a2*b123) (a3*b123)+ (a123*b0)+ (TPV a23 a31 a12 a123) * (C b0 b123) = APS (negate $ a123*b123)+ (negate $ a23*b123) (negate $ a31*b123) (negate $ a12*b123)+ (a23*b0) (a31*b0) (a12*b0)+ (a123*b0)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (C b0 b123) = APS (a0*b0 - a123*b123)+ (a1*b0 - a23*b123) (a2*b0 - a31*b123) (a3*b0 - a12*b123)+ (a23*b0 + a1*b123) (a31*b0 + a2*b123) (a12*b0 + a3*b123)+ (a0*b123 + a123*b0)++ (BPV a1 a2 a3 a23 a31 a12) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)+ (a12*b2 - a2*b12 + a3*b31 - a31*b3)+ (a1*b12 - a12*b1 - a3*b23 + a23*b3)+ (a31*b1 - a1*b31 + a2*b23 - a23*b2)+ (a2*b3 - a3*b2 - a31*b12 + a12*b31)+ (a3*b1 - a1*b3 + a23*b12 - a12*b23)+ (a1*b2 - a2*b1 - a23*b31 + a31*b23)+ (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)++ (BPV a1 a2 a3 a23 a31 a12) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3)+ (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)+ (a1*b123 + a2*b3 - a3*b2) (a2*b123 - a1*b3 + a3*b1) (a3*b123 + a1*b2 - a2*b1)+ (a23*b1 + a31*b2 + a12*b3)+ (BPV a1 a2 a3 a23 a31 a12) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a3*b31 - a2*b12 - a23*b123) (a1*b12 - a3*b23 - a31*b123) (a2*b23 - a1*b31 - a12*b123)+ (a1*b123 - a31*b12 + a12*b31) (a2*b123 + a23*b12 - a12*b23) (a3*b123 - a23*b31 + a31*b23)+ (a1*b23 + a2*b31 + a3*b12)+ (BPV a1 a2 a3 a23 a31 a12) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)+ (a1*b0 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a23*b123)+ (a2*b0 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a31*b123)+ (a3*b0 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a12*b123)+ (a23*b0 + a1*b123 + a2*b3 - a3*b2 - a31*b12 + a12*b31)+ (a31*b0 - a1*b3 + a3*b1 + a2*b123 + a23*b12 - a12*b23)+ (a12*b0 + a1*b2 - a2*b1 + a3*b123 - a23*b31 + a31*b23)+ (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)++ (ODD a1 a2 a3 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3)+ (a3*b31 - a2*b12 - a123*b23) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a1*b31 - a123*b12)+ (a123*b1 + a2*b3 - a3*b2) (a123*b2 - a1*b3 + a3*b1) (a123*b3 + a1*b2 - a2*b1)+ (a1*b23 + a2*b31 + a3*b12)+ (TPV a23 a31 a12 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (negate $ a23*b23 + a31*b31 + a12*b12)+ (a12*b2 - a31*b3 - a123*b23) (a23*b3 - a12*b1 - a123*b31) (a31*b1 - a23*b2 - a123*b12)+ (a123*b1 - a31*b12 + a12*b31) (a123*b2 + a23*b12 - a12*b23) (a123*b3 - a23*b31 + a31*b23)+ (a23*b1 + a31*b2 + a12*b3)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (BPV b1 b2 b3 b23 b31 b12) = APS (a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12)+ (a0*b1 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a123*b23)+ (a0*b2 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a123*b31)+ (a0*b3 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a123*b12)+ (a0*b23 + a123*b1 + a2*b3 - a3*b2 - a31*b12 + a12*b31)+ (a0*b31 - a1*b3 + a3*b1 + a123*b2 + a23*b12 - a12*b23)+ (a0*b12 + a1*b2 - a2*b1 + a123*b3 - a23*b31 + a31*b23)+ (a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)++ (ODD a1 a2 a3 a123) * (ODD b1 b2 b3 b123) = H (a1*b1 + a2*b2 + a3*b3 - a123*b123)+ (a1*b123 + a123*b1 + a2*b3 - a3*b2)+ (a2*b123 + a123*b2 - a1*b3 + a3*b1)+ (a3*b123 + a123*b3 + a1*b2 - a2*b1)++ (ODD a1 a2 a3 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a123*b123)+ (a3*b31 - a2*b12 - a123*b23) (a1*b12 - a3*b23 - a123*b31) (a2*b23 - a1*b31 - a123*b12)+ (a1*b123) (a2*b123) (a3*b123)+ (a1*b23 + a2*b31 + a3*b12)+ (ODD a1 a2 a3 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a123*b123)+ (a1*b0 - a2*b12 + a3*b31 - a123*b23)+ (a2*b0 + a1*b12 - a3*b23 - a123*b31)+ (a3*b0 - a1*b31 + a2*b23 - a123*b12)+ (a1*b123 + a123*b1 + a2*b3 - a3*b2)+ (a2*b123 + a123*b2 - a1*b3 + a3*b1)+ (a3*b123 + a123*b3 + a1*b2 - a2*b1)+ (a123*b0 + a1*b23 + a2*b31 + a3*b12)++ (TPV a23 a31 a12 a123) * (ODD b1 b2 b3 b123) = APS (negate $ a123*b123)+ (a12*b2 - a31*b3 - a23*b123) (a23*b3 - a12*b1 - a31*b123) (a31*b1 - a23*b2 - a12*b123)+ (a123*b1) (a123*b2) (a123*b3)+ (a23*b1 + a31*b2 + a12*b3)+ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (ODD b1 b2 b3 b123) = APS (a1*b1 + a2*b2 + a3*b3 - a123*b123)+ (a0*b1 + a12*b2 - a31*b3 - a23*b123)+ (a0*b2 - a12*b1 + a23*b3 - a31*b123)+ (a0*b3 + a31*b1 - a23*b2 - a12*b123)+ (a1*b123 + a123*b1 + a2*b3 - a3*b2)+ (a2*b123 + a123*b2 - a1*b3 + a3*b1)+ (a3*b123 + a123*b3 + a1*b2 - a2*b1)+ (a0*b123 + a23*b1 + a31*b2 + a12*b3)++ (TPV a23 a31 a12 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)+ (negate $ a23*b123 + a123*b23) (negate $ a31*b123 + a123*b31) (negate $ a12*b123 + a123*b12)+ (a12*b31 - a31*b12) (a23*b12 - a12*b23) (a31*b23 - a23*b31)+ 0++ (TPV a23 a31 a12 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)+ (a12*b2 - a31*b3 - a23*b123 - a123*b23)+ (a23*b3 - a12*b1 - a31*b123 - a123*b31)+ (a31*b1 - a23*b2 - a12*b123 - a123*b12)+ (a23*b0 + a123*b1 - a31*b12 + a12*b31)+ (a31*b0 + a123*b2 + a23*b12 - a12*b23)+ (a12*b0 + a123*b3 - a23*b31 + a31*b23)+ (a123*b0 + a23*b1 + a31*b2 + a12*b3)++ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (TPV b23 b31 b12 b123) = APS (negate $ a23*b23 + a31*b31 + a12*b12 + a123*b123)+ (a3*b31 - a2*b12 - a23*b123 - a123*b23)+ (a1*b12 - a3*b23 - a31*b123 - a123*b31)+ (a2*b23 - a1*b31 - a12*b123 - a123*b12)+ (a0*b23 + a1*b123 - a31*b12 + a12*b31)+ (a0*b31 + a2*b123 + a23*b12 - a12*b23)+ (a0*b12 + a3*b123 - a23*b31 + a31*b23)+ (a0*b123 + a1*b23 + a2*b31 + a3*b12)++ (APS a0 a1 a2 a3 a23 a31 a12 a123) * (APS b0 b1 b2 b3 b23 b31 b12 b123) = APS (a0*b0 + a1*b1 + a2*b2 + a3*b3 - a23*b23 - a31*b31 - a12*b12 - a123*b123)+ (a0*b1 + a1*b0 - a2*b12 + a12*b2 + a3*b31 - a31*b3 - a23*b123 - a123*b23)+ (a0*b2 + a2*b0 + a1*b12 - a12*b1 - a3*b23 + a23*b3 - a31*b123 - a123*b31)+ (a0*b3 + a3*b0 - a1*b31 + a31*b1 + a2*b23 - a23*b2 - a12*b123 - a123*b12)+ (a0*b23 + a23*b0 + a1*b123 + a123*b1 + a2*b3 - a3*b2 - a31*b12 + a12*b31)+ (a0*b31 + a31*b0 - a1*b3 + a3*b1 + a2*b123 + a123*b2 + a23*b12 - a12*b23)+ (a0*b12 + a12*b0 + a1*b2 - a2*b1 + a3*b123 + a123*b3 - a23*b31 + a31*b23)+ (a0*b123 + a123*b0 + a1*b23 + a23*b1 + a2*b31 + a31*b2 + a3*b12 + a12*b3)+++ -- |'abs' is the spectral norm aka the spectral radius+ -- it is the largest singular value. This function may need to be fiddled with+ -- to make the math a bit safer wrt overflows. This makes use of the largest+ -- singular value, if the littlest singular value is zero then the element is not+ -- invertable, we can see here that R, C, V3, BV, and H are all invertable, and+ -- by implication R, C, and H are division algebras.+ abs (R a0) = R (abs a0) -- absolute value of a real number+ abs (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2)) -- magnitude of a vector+ abs (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2)) -- magnitude of a bivector+ abs (I a123) = R (abs a123) -- magnitude of a Imaginary number+ abs (PV a0 a1 a2 a3) = R (reimMag a0 a1 a2 a3)+ abs (TPV a23 a31 a12 a123) = R (reimMag a123 a23 a31 a12)+ abs (H a0 a23 a31 a12) = R (sqrt (a0^2 + a23^2 + a31^2 + a12^2)) -- largest singular value+ abs (C a0 a123) = R (sqrt (a0^2 + a123^2)) -- magnitude of a complex number+ abs (BPV a1 a2 a3 a23 a31 a12) =+ let x = sqrt ((a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2) -- core was duplicating this computation added let to hopefully reduce the duplication+ in R (sqrt (a1^2 + a23^2 + a2^2 + a31^2 + a3^2 + a12^2 + x + x))+ abs (ODD a1 a2 a3 a123) = R (sqrt (a1^2 + a2^2 + a3^2 + a123^2))+ abs (APS a0 a1 a2 a3 a23 a31 a12 a123) =+ let x = sqrt ((a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 ++ (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2) -- core was duplicating this computation added let to hopefully reduce the duplication+ in R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 + x + x))+++ -- |'signum' satisfies the Law "abs x * signum x == x"+ -- kind of cool: signum of a vector is it's unit vector.+ signum (R a0) = R (signum a0)+ signum (V3 a1 a2 a3) =+ let mag = sqrt (a1^2 + a2^2 + a3^2)+ invMag = recip mag+ in if mag == 0+ then R 0+ else V3 (invMag * a1) (invMag * a2) (invMag * a3)+ signum (BV a23 a31 a12) =+ let mag = sqrt (a23^2 + a31^2 + a12^2)+ invMag = recip mag+ in if mag == 0+ then R 0+ else BV (invMag * a23) (invMag * a31) (invMag * a12)+ signum (I a123) = I (signum a123)+ signum (PV a0 a1 a2 a3) =+ let mag = reimMag a0 a1 a2 a3+ invMag = recip mag+ in if mag == 0+ then R 0+ else PV (invMag * a0) (invMag * a1) (invMag * a2) (invMag * a3)+ signum (H a0 a23 a31 a12) =+ let mag = sqrt (a0^2 + a23^2 + a31^2 + a12^2)+ invMag = recip mag+ in if mag == 0+ then R 0+ else H (invMag * a0) (invMag * a23) (invMag * a31) (invMag * a12)+ signum (C a0 a123) =+ let mag = sqrt (a0^2 + a123^2)+ invMag = recip mag+ in if mag == 0+ then R 0+ else C (invMag * a0) (invMag * a123)+ signum (BPV a1 a2 a3 a23 a31 a12) =+ let x = sqrt ((a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2)+ mag = sqrt (a1^2 + a23^2 + a2^2 + a31^2 + a3^2 + a12^2 + x + x)+ invMag = recip mag+ in if mag == 0+ then R 0+ else BPV (invMag * a1) (invMag * a2) (invMag * a3) (invMag * a23) (invMag * a31) (invMag * a12)+ signum (ODD a1 a2 a3 a123) =+ let mag = sqrt (a1^2 + a2^2 + a3^2 + a123^2)+ invMag = recip mag+ in if mag == 0+ then R 0+ else ODD (invMag * a1) (invMag * a2) (invMag * a3) (invMag * a123)+ signum (TPV a23 a31 a12 a123) =+ let mag = reimMag a123 a23 a31 a12+ invMag = recip mag+ in if mag == 0+ then R 0+ else TPV (invMag * a23) (invMag * a31) (invMag * a12) (invMag * a123)+ signum (APS a0 a1 a2 a3 a23 a31 a12 a123) =+ let x = sqrt ((a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 + (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2)+ mag = sqrt (a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 + x + x)+ invMag = recip mag+ in if mag == 0+ then R 0+ else APS (invMag * a0) (invMag * a1) (invMag * a2) (invMag * a3) (invMag * a23) (invMag * a31) (invMag * a12) (invMag * a123)+++ -- |'fromInteger'+ fromInteger int = R (fromInteger int)+++ -- |'negate' simply distributes into the grade components+ negate (R a0) = R (negate a0)+ negate (V3 a1 a2 a3) = V3 (negate a1) (negate a2) (negate a3)+ negate (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)+ negate (I a123) = I (negate a123)+ negate (PV a0 a1 a2 a3) = PV (negate a0)+ (negate a1) (negate a2) (negate a3)+ negate (H a0 a23 a31 a12) = H (negate a0)+ (negate a23) (negate a31) (negate a12)+ negate (C a0 a123) = C (negate a0)+ (negate a123)+ negate (BPV a1 a2 a3 a23 a31 a12) = BPV (negate a1) (negate a2) (negate a3)+ (negate a23) (negate a31) (negate a12)+ negate (ODD a1 a2 a3 a123) = ODD (negate a1) (negate a2) (negate a3)+ (negate a123)+ negate (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12)+ (negate a123)+ negate (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS (negate a0)+ (negate a1) (negate a2) (negate a3)+ (negate a23) (negate a31) (negate a12)+ (negate a123)++-- | 'reimMag' small helper function to calculate magnitude for PV and TPV+reimMag :: Double -> Double -> Double -> Double -> Double+reimMag v0 v1 v2 v3 =+ let sumsqs = v1^2 + v2^2 + v3^2+ x = abs v0 * sqrt sumsqs+ in sqrt (v0^2 + sumsqs + x + x)++-- |Cl(3,0) has a Fractional instance+instance Fractional Cl3 where+ -- |Some of the sub algebras are division algebras but APS is not a division algebra+ recip (R a0) = R (recip a0) -- R is a division algebra+ recip cliff = + let (R mag) = abs cliff+ recipsqmag = recip mag^2+ negrecipsqmag = negate recipsqmag+ recipmag2 = recip.toR $ cliff * bar cliff+ go_recip (V3 a1 a2 a3) = V3 (recipsqmag * a1) (recipsqmag * a2) (recipsqmag * a3)+ go_recip (BV a23 a31 a12) = BV (negrecipsqmag * a23) (negrecipsqmag * a31) (negrecipsqmag * a12)+ go_recip (I a123) = I (negrecipsqmag * a123)+ go_recip (H a0 a23 a31 a12) = H (recipsqmag * a0) (negrecipsqmag * a23) (negrecipsqmag * a31) (negrecipsqmag * a12) -- H is a division algebra+ go_recip (C a0 a123) = C (recipsqmag * a0) (negrecipsqmag * a123) -- C is a division algebra+ go_recip (ODD a1 a2 a3 a123) = ODD (recipsqmag * a1) (recipsqmag * a2) (recipsqmag * a3) (negrecipsqmag * a123)+ go_recip pv@PV{} = recipmag2 * bar pv+ go_recip tpv@TPV{} = recipmag2 * bar tpv+ go_recip cliffor = reduce $ spectraldcmp recip recip' cliffor+ in go_recip cliff+++ -- |'fromRational'+ fromRational rat = R (fromRational rat)+++-- |Cl(3,0) has a "Floating" instance.+instance Floating Cl3 where+ pi = R pi++ --+ exp (R a0) = R (exp a0)+ exp (I a123) = C (cos a123) (sin a123)+ exp (C a0 a123) =+ let expa0 = exp a0+ in C (expa0 * cos a123) (expa0 * sin a123)+ exp cliffor = spectraldcmp exp exp' cliffor++ --+ log (R a0)+ | a0 >= 0 = R (log a0)+ | a0 == (-1) = I pi+ | otherwise = C (log.negate $ a0) pi+ log (I a123)+ | a123 == 1 = I (pi/2)+ | a123 == (-1) = I (-pi/2)+ | otherwise = C (log.abs $ a123) (signum a123 * (pi/2))+ log (C a0 a123) = C (log (a0^2 + a123^2) / 2) (atan2 a123 a0)+ log cliffor = spectraldcmp log log' cliffor++ --+ sqrt (R a0)+ | a0 >= 0 = R (sqrt a0)+ | otherwise = I (sqrt.negate $ a0)+ sqrt (I a123)+ | a123 == 0 = R 0+ | otherwise =+ let sqrtr = sqrt.abs $ a123+ phiby2 = signum a123 * (pi/4) -- evaluated: atan2 a123 0 / 2+ in C (sqrtr * cos phiby2) (sqrtr * sin phiby2)+ sqrt (C a0 a123) =+ let sqrtr = sqrt.sqrt $ a0^2 + a123^2+ phiby2 = atan2 a123 a0 / 2+ in C (sqrtr * cos phiby2) (sqrtr * sin phiby2)+ sqrt cliffor = spectraldcmp sqrt sqrt' cliffor++ --+ sin (R a0) = R (sin a0)+ sin (I a123)+ | a123 == 0 = R 0+ | otherwise = I (sinh a123)+ sin (C a0 a123) = C (sin a0 * cosh a123) (cos a0 * sinh a123)+ sin cliffor = spectraldcmp sin sin' cliffor++ --+ cos (R a0) = R (cos a0)+ cos (I a123) = R (cosh a123)+ cos (C a0 a123) = C (cos a0 * cosh a123) (negate $ sin a0 * sinh a123)+ cos cliffor = spectraldcmp cos cos' cliffor++ --+ tan (R a0) = R (tan a0)+ tan (I a123)+ | a123 == 0 = R 0+ | otherwise = I (tanh a123)+ tan (C a0 a123) =+ let+ m = x2^2 + y2^2+ x1 = sinx*coshy+ y1 = cosx*sinhy+ x2 = cosx*coshy+ y2 = negate $ sinx*sinhy+ sinx = sin a0+ cosx = cos a0+ sinhy = sinh a123+ coshy = cosh a123+ in C ((x1*x2 + y1*y2)/m) ((x2*y1 - x1*y2)/m)+ tan cliffor = spectraldcmp tan tan' cliffor++ --+ asin (R a0)+ -- asin (R a0) = I (-1) * log (I 1 * R a0 + sqrt (1 - (R a0)^2))+ -- I (-1) * log (I a0 + sqrt (R 1 - (R a0)^2))+ -- I (-1) * log (I a0 + sqrt (R (1 - a0^2)))+ -- I (-1) * log (I a0 + (I (sqrt.negate $ 1 - a0^2)))+ -- I (-1) * log (I a0 + (sqrt.negate $ 1 - a0^2))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- I (-1) * C (log.abs $ (a0 + (sqrt.negate $ 1 - a0^2))) (signum (a0 + (sqrt.negate $ 1 - a0^2)) * (pi/2))+ -- C (signum (a0 + (sqrt.negate $ 1 - a0^2)) * (pi/2)) (negate.log.abs $ (a0 + (sqrt.negate $ 1 - a0^2)))+ | a0 > 1 = C (pi/2) (negate.log $ (a0 + sqrt (a0^2 - 1)))+ -- I (-1) * log (I a0 + R (sqrt $ 1 - a0^2))+ -- I (-1) * log (C (sqrt $ 1 - a0^2) a0)+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- I (-1) * C (log.sqrt $ (sqrt $ 1 - a0^2)^2 + a0^2) (atan2 a0 (sqrt $ 1 - a0^2))+ -- C (atan2 a0 (sqrt $ 1 - a0^2)) (negate.log.sqrt $ (sqrt $ 1 - a0^2)^2 + a0^2)+ -- C (atan(a0/(sqrt $ 1 - a0^2))) (negate.log.sqrt $ 1)+ -- Apply sqrt 1 == 1, Apply log 1 == 0, reduce+ -- R (atan(a0/(sqrt $ 1 - a0^2)))+ -- Identity: tan(asin x) = x / (sqrt (1 - x^2))+ -- R (asin a0)+ | a0 >= (-1) = R (asin a0)+ -- I (-1) * log (I a0 + sqrt (R (1 - a0^2)))+ -- I (-1) * log (I (a0 + (sqrt.negate $ 1 - a0^2)))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- I (-1) * C (log.abs $ (a0 + (sqrt.negate $ 1 - a0^2))) (signum (a0 + (sqrt.negate $ 1 - a0^2)) * (pi/2))+ -- C (signum (a0 + (sqrt.negate $ 1 - a0^2)) * (pi/2)) (negate.log.abs $ (a0 + (sqrt.negate $ 1 - a0^2)))+ -- For the negative branch signum is -1+ -- C (-pi/2) (negate.log.abs $ (a0 + (sqrt $ a0^2 - 1)))+ | otherwise = C (-pi/2) (negate.log.abs $ (a0 + sqrt (a0^2 - 1)))+ --+ -- For I:+ -- I (-1) * log (I (1) * I a123 + sqrt (R 1 - (I a123)^2))+ -- I (-1) * log (R (-a123) + sqrt (R 1 - (I a123)^2))+ -- I (-1) * log (R (-a123) + sqrt (R 1 - R (-a123^2)))+ -- I (-1) * log (R (-a123) + sqrt (R (1 + a123^2)))+ -- I (-1) * log (R (-a123) + R (sqrt $ 1 + a123^2))+ -- I (-1) * log (R ((sqrt $ 1 + a123^2) - a123))+ -- ((sqrt $ 1 + a123^2) - a123)) is always positive+ -- Def ==> log (R a0) | a0 >= 0 = R (log a0)+ -- I (-1) * (R (log $ (sqrt $ 1 + a123^2) - a123))+ -- I (negate.log $ (sqrt $ 1 + a123^2) - a123)+ -- I (negate.log $ (sqrt $ 1 + a123^2) - a123)+ -- because ((sqrt $ 1 + a123^2) - a123)) is always positive: negate.log == log.recip+ -- I (log.recip $ (sqrt $ 1 + a123^2) - a123)+ -- recip $ (sqrt $ 1 + a123^2) - a123) == (sqrt $ 1 + a123^2) + a123)+ -- I (log $ (sqrt $ 1 + a123^2) + a123)+ -- I (asinh a123)+ asin (I a123)+ | a123 == 0 = R 0+ | otherwise = I (asinh a123)+ --+ asin (C a0 a123) =+ -- For C:+ -- I (-1) * log (I 1 * C a0 a123 + sqrt (R 1 - (C a0 a123)^2))+ -- I (-1) * log (C (-a123) a0 + sqrt (R 1 - (C a0 a123)^2))+ -- I (-1) * log (C (-a123) a0 + sqrt (C (1 - a0^2 + a123^2) (-2*a0*a123)))+ -- Def ==> sqrt (C a0 a123) = C ((sqrt.sqrt $ a0^2 + a123^2) * cos (atan2 a123 a0 / 2)) ((sqrt.sqrt $ a0^2 + a123^2) * sin (atan2 a123 a0 / 2))+ -- I (-1) * log (C (-a123) a0 + C ((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) ((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)))+ -- I (-1) * log (C (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123) (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0))+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- C (atan2 (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0)+ -- (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123))+ -- (negate.log.sqrt $ (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123)^2 ++ -- (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0)^2)+ -- Collect like terms:+ let theta = atan2 (-2*a0*a123) (1 - a0^2 + a123^2)+ rho = sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2+ b0 = rho * cos (theta/2) - a123+ b123 = rho * sin (theta/2) + a0+ in C (atan2 b123 b0) (log (b0^2 + b123^2) / (-2))+ --+ asin cliffor = spectraldcmp asin asin' cliffor++ --+ acos (R a0)+ -- acos x == (pi/2) - asin x so just subistute+ -- For R a0 > 1:+ -- R (pi/2) - C (pi/2) (negate.log $ (a0 + (sqrt $ a0^2 - 1)))+ -- C 0 (negate.negate.log $ (a0 + (sqrt $ a0^2 - 1)))+ -- I (log $ (a0 + (sqrt $ a0^2 - 1)))+ | a0 > 1 = I (log (a0 + sqrt (a0^2 - 1)))+ -- For R a0 > (-1)+ -- R (pi/2) - R (asin a0) == R (acos a0)+ | a0 >= (-1) = R (acos a0)+ -- For R otherwise:+ -- R (pi/2) - C (-pi/2) (negate.log.abs $ (a0 + (sqrt $ a0^2 - 1)))+ -- C pi (negate.negate.log.abs $ (a0 + (sqrt $ a0^2 - 1)))+ -- C pi (log.abs $ (a0 + (sqrt $ a0^2 - 1)))+ | otherwise = C pi (log.abs $ (a0 + sqrt (a0^2 - 1)))+ --+ -- For I:+ -- asin (I a123) = I (asinh a123) -- so,+ -- acos x == R (pi/2) - I (asinh a123)+ -- C (pi/2) (negate $ asinh a123)+ acos (I a123)+ | a123 == 0 = R (pi/2)+ | otherwise = C (pi/2) (negate $ asinh a123)+ --+ acos (C a0 a123) =+ -- For C:+ -- asin (C a0 a123) = C (atan2 (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0) (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123)) (negate.log.sqrt $ (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123)^2 + (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0)^2)+ -- acos x == (pi/2) - asin x so just subistute+ -- R (pi/2) - C (atan2 (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0) (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123)) (negate.log.sqrt $ (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * cos (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) - a123)^2 + (((sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2) * sin (atan2 (-2*a0*a123) (1 - a0^2 + a123^2) / 2)) + a0)^2)+ let theta = atan2 (-2*a0*a123) (1 - a0^2 + a123^2)+ rho = sqrt.sqrt $ (1 - a0^2 + a123^2)^2 + (-2*a0*a123)^2+ b0 = rho * cos (theta/2) - a123+ b123 = rho * sin (theta/2) + a0+ in C ((pi/2) - atan2 b123 b0) (log (b0^2 + b123^2) / 2)+ --+ acos cliffor = spectraldcmp acos acos' cliffor++ --+ atan (R a0) = R (atan a0)+ --+ atan (I a123)+ -- I (0.5) * (log (R 1 - (I 1 * I a123)) - log (R 1 + (I 1 * I a123)))+ -- I (0.5) * (log (R 1 - (R (-a123))) - log (R 1 + (R (-a123))))+ -- I (0.5) * ((log (R (1 + a123))) - log (R (1 - a123)))+ -- Def ==> C (log.negate $ a0) pi for negative a123+ -- I (0.5) * ((log (R (1 + a123))) - (C (log.negate $ (1 - a123)) pi))+ -- Def ==> R (log a0) for positive a123+ -- I (0.5) * ((R (log (1 + a123))) - (C (log.negate $ (1 - a123)) pi))+ -- I (0.5) * (C (log (1 + a123) - (log.negate $ (1 - a123))) (-pi))+ -- C (pi/2) ((log (1 + a123) - (log.negate $ (1 - a123)))/2)+ | a123 > 1 = C (pi/2) (0.5*(log (1 + a123) - log (a123 - 1)))+ -- I (0.5) * (log (R 1 - (I 1 * I a123)) - log (R 1 + (I 1 * I a123)))+ -- I (0.5) * (log (R 1 - (R (-a123))) - log (R 1 + (R (-a123))))+ -- I (0.5) * ((log (R (1 + a123))) - log (R (1 - a123)))+ -- I (0.5) * ((R (log (1 + a123))) - R (log (1 - a123)))+ -- I (0.5) * (R ((log (1 + a123)) - (log (1 - a123))))+ -- I (((log (1 + a123)) - (log (1 - a123)))/2)+ -- I (atanh a123)+ | a123 == 0 = R 0+ | a123 >= (-1) = I (atanh a123)+ -- I (0.5) * (log (R 1 - (I 1 * I a123)) - log (R 1 + (I 1 * I a123)))+ -- I (0.5) * (log (R 1 - (R (-a123))) - log (R 1 + (R (-a123))))+ -- I (0.5) * ((log (R (1 + a123))) - R (log (1 - a123)))+ -- C (-pi/2) (((log.negate $ (1 + a123)) - (log (1 - a123)))/2)+ | otherwise = C (-pi/2) (((log.negate $ (1 + a123)) - log (1 - a123))/2)+ --+ -- I (0.5) * (log (R 1 - (I 1 * C a0 a123)) - log (R 1 + (I 1 * C a0 a123)))+ -- I (0.5) * (log (C (1 + a123) (-a0)) - log (C (1 - a123) a0))+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- I (0.5) * ((C (log.sqrt $ (1 + a123)^2 + (-a0)^2) (atan2 (-a0) (1 + a123))) - (C (log.sqrt $ (1 - a123)^2 + a0^2) (atan2 a0 (1 - a123))))+ -- I (0.5) * C ((log.sqrt $ (1 + a123)^2 + (-a0)^2) - (log.sqrt $ (1 - a123)^2 + a0^2)) ((atan2 (-a0) (1 + a123)) - (atan2 a0 (1 - a123)))+ -- I (0.5) * C (0.5*((log $ (1 + a123)^2 + a0^2) - (log $ (1 - a123)^2 + a0^2))) ((atan2 (-a0) (1 + a123)) - (atan2 a0 (1 - a123)))+ -- C (((atan2 a0 (1 - a123)) + (atan2 a0 (1 + a123)))/2) (((log $ (1 + a123)^2 + a0^2) - (log $ (1 - a123)^2 + a0^2))/4)+ atan (C a0 a123) = C ((atan2 a0 (1 - a123) + atan2 a0 (1 + a123))/2)+ ((log ((1 + a123)^2 + a0^2) - log ((1 - a123)^2 + a0^2))/4)+ --+ atan cliffor = spectraldcmp atan atan' cliffor++ --+ sinh (R a0) = R (sinh a0)+ sinh (I a123) = I (sin a123)+ sinh (C a0 a123) = C (cos a123 * sinh a0) (sin a123 * cosh a0)+ sinh cliffor = spectraldcmp sinh sinh' cliffor++ --+ cosh (R a0) = R (cosh a0)+ cosh (I a123) = R (cos a123)+ cosh (C a0 a123) = C (cos a123 * cosh a0) (sin a123 * sinh a0)+ cosh cliffor = spectraldcmp cosh cosh' cliffor++ --+ tanh (R a0) = R (tanh a0)+ tanh (I a123) = I (tan a123)+ tanh (C a0 a123) =+ let+ m = x2^2 + y2^2+ x1 = cosy*sinhx+ y1 = siny*coshx+ x2 = cosy*coshx+ y2 = siny*sinhx+ siny = sin a123+ cosy = cos a123+ sinhx = sinh a0+ coshx = cosh a0+ in C ((x1*x2 + y1*y2)/m) ((x2*y1 - x1*y2)/m)+ tanh cliffor = spectraldcmp tanh tanh' cliffor++ --+ asinh (R a0) = R (asinh a0)+ --+ asinh (I a123)+ -- log (I a123 + sqrt (R (1 - a123^2)))+ -- 3 branches where between -1 and 1 it is just asin+ -- For a123 > 1:+ -- log (I a123 + I (sqrt.negate $ (1 - a123^2)))+ -- log (I (a123 + (sqrt (a123^2 - 1))))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- C (log.abs $ (a123 + (sqrt (a123^2 - 1)))) (signum (a123 + (sqrt (a123^2 - 1))) * (pi/2))+ -- a123 is positive so signum evaluates to 1+ -- C (log.abs $ (a123 + (sqrt (a123^2 - 1)))) (pi/2)+ | a123 > 1 = C (log.abs $ (a123 + sqrt (a123^2 - 1))) (pi/2)+ -- log (I a123 + sqrt (R (1 - a123^2)))+ -- log (I a123 + R (sqrt (1 - a123^2)))+ -- log (C (sqrt (1 - a123^2)) a123)+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- C (log.sqrt $ (sqrt (1 - a123^2))^2 + a123^2) (atan2 a123 (sqrt (1 - a123^2)))+ -- (sqrt (1 - a123^2))^2 + a123^2 == 1+ -- sqrt 1 == 1+ -- log 1 == 0+ -- I (atan2 a123 (sqrt (1 - a123^2)))+ -- I (atan (a123 / (sqrt (1 - a123^2))))+ -- Identity: tan(asin x) = x / (sqrt (1 - x^2))+ -- asin a123 = atan (a123 / (sqrt (1 - a123^2)))+ | a123 == 0 = R 0+ | a123 >= (-1) = I (asin a123)+ -- log (I a123 + sqrt (R (1 - a123^2)))+ -- For a123 < (-1):+ -- log (I a123 + I (sqrt.negate $ (1 - a123^2)))+ -- log (I (a123 + (sqrt (a123^2 - 1))))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- C (log.abs $ (a123 + (sqrt (a123^2 - 1)))) (signum (a123 + (sqrt (a123^2 - 1))) * (pi/2))+ -- for a123 lt (-1) signum evaluates to -1+ | otherwise = C (log.abs $ (a123 + sqrt (a123^2 - 1))) (-pi/2)+ --+ asinh (C a0 a123) =+ -- For C:+ -- log (C a0 a123 + sqrt (C (a0^2 - a123^2 +1) (2*a0*a123)))+ -- Def ==> sqrt (C a0 a123) = C ((sqrt.sqrt $ a0^2 + a123^2) * cos (atan2 a123 a0 / 2)) ((sqrt.sqrt $ a0^2 + a123^2) * sin (atan2 a123 a0 / 2))+ -- log (C a0 a123 + C ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * cos (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2)) ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * sin (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2)))+ -- log (C (a0 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * cos (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2))) (a123 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * sin (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2))))+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- C (log.sqrt $ (a0 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * cos (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2)))^2 ++ -- (a123 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * sin (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2)))^2)+ -- (atan2 (a123 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * sin (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2)))+ -- (a0 + ((sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2) * cos (atan2 (2*a0*a123) (a0^2 - a123^2 +1) / 2))))+ -- Collect like terms:+ let theta = atan2 (2*a0*a123) (a0^2 - a123^2 +1)+ rho = sqrt.sqrt $ (a0^2 - a123^2 +1)^2 + (2*a0*a123)^2+ b0 = a0 + rho * cos (theta/2)+ b123 = a123 + rho * sin (theta/2)+ in C (log (b0^2 + b123^2) / 2) (atan2 b123 b0)+ --+ asinh cliffor = spectraldcmp asinh asinh' cliffor++ --+ acosh (R a0)+ -- log (R a0 + sqrt(R (a0+1)) * sqrt(R (a0-1)))+ | a0 >= 1 = R (acosh a0)+ -- log (R a0 + sqrt(R (a0+1)) * sqrt(R (a0-1)))+ -- log (R a0 + R (sqrt $ a0+1) * R (sqrt $ a0-1))+ -- log (R a0 + R ((sqrt $ a0+1) * (sqrt $ a0-1)))+ -- log (R (a0 + (sqrt $ a0+1) * (sqrt $ a0-1)))+ -- R (log $ a0 + (sqrt $ a0+1) * (sqrt $ a0-1))+ -- R (acosh a0)+ -- Strangely ghc substitutes 'acosh a0' with something like:+ -- R (log $ a0 + (a0 + 1 ) * (sqrt $ (a0 - 1)/(a0 + 1)))+ | a0 >= (-1) = I (atan2 (sqrt $ 1-a0^2) a0) -- This is I because of cancelation of the real component+ -- log (R a0 + sqrt(R (a0+1)) * sqrt(R (a0-1)))+ -- log (R a0 + R (sqrt $ a0+1) * I (sqrt.negate $ a0-1))+ -- log (R a0 + I ((sqrt $ a0+1) * (sqrt.negate $ a0-1)))+ -- log (R a0 + I ((sqrt $ a0+1) * (sqrt $ 1-a0)))+ -- log $ C (a0) ((sqrt $ a0+1) * (sqrt $ 1-a0))+ -- Def log ==> log (C b0 b123) = C (log.sqrt $ b0^2 + b123^2) (atan2 b123 b0)+ -- let b0 = a0+ -- b123 = (sqrt $ a0+1) * (sqrt $ 1-a0) = sqrt $ 1-a0^2+ -- in C (log.sqrt $ b0^2 + b123^2) (atan2 b123 b0)+ -- b123^2 = 1-a0^2+ -- C (log.sqrt $ a0^2 + 1-a0^2) (atan2 (sqrt $ 1-a0^2) a0)+ -- C (log.sqrt $ 1) (atan2 (sqrt $ 1-a0^2) a0)+ -- C 0 (atan2 (sqrt $ 1-a0^2) a0)+ -- I (atan2 (sqrt $ 1-a0^2) a0)+ | otherwise = C (acosh.negate $ a0) pi+ -- log (R a0 + sqrt(R (a0+1)) * sqrt(R (a0-1)))+ -- log (R a0 + I (sqrt.negate $ a0+1) * I (sqrt.negate $ a0-1))+ -- Def ==> (I a123) * (I b123) = R (negate $ a123*b123)+ -- log (R a0 + R (negate $ (sqrt.negate $ a0+1) * (sqrt.negate $ a0-1))+ -- log (R (a0 + (negate $ (sqrt.negate $ a0+1) * (sqrt.negate $ a0-1))))+ -- C (log.negate $ (a0 + (negate $ (sqrt.negate $ a0+1) * (sqrt.negate $ a0-1)))) pi+ -- C (log $ (negate a0 + ((sqrt $ (negate a0)+1) * (sqrt $ (negate a0)-1)))) pi+ -- C (acosh (negate a0)) pi+ --+ acosh (I a123)+ -- log (I a123 + sqrt(C 1 a123) * sqrt(C (-1) a123))+ -- Def ==> sqrt (C a0 a123) =+ -- C ((sqrt.sqrt $ a0^2 + a123^2) * cos (atan2 a123 a0 / 2))+ -- ((sqrt.sqrt $ a0^2 + a123^2) * sin (atan2 a123 a0 / 2))+ -- log (I a123 ++ -- C ((sqrt.sqrt $ 1 + a123^2) * cos (atan2 a123 1 / 2))+ -- ((sqrt.sqrt $ 1 + a123^2) * sin (atan2 a123 1 / 2)) *+ -- C ((sqrt.sqrt $ 1 + a123^2) * cos (atan2 a123 (-1) / 2))+ -- ((sqrt.sqrt $ 1 + a123^2) * sin (atan2 a123 (-1) / 2)) )+ -- Factor out "(sqrt.sqrt $ 1 + a123^2)*"+ -- log (I a123 + R (sqrt.sqrt $ 1 + a123^2) *+ -- C (cos (atan2 a123 1 / 2)) (sin (atan2 a123 1 / 2)) *+ -- R (sqrt.sqrt $ 1 + a123^2) *+ -- C (cos (atan2 a123 (-1) / 2)) (sin (atan2 a123 (-1) / 2)))+ -- Collect both R's and simplify+ -- log (I a123 + (R (sqrt $ 1 + a123^2)) *+ -- C (cos (atan2 a123 1 / 2)) (sin (atan2 a123 1 / 2)) *+ -- C (cos (atan2 a123 (-1) / 2)) (sin (atan2 a123 (-1) / 2)))+ -- Def ==> (C a0 a123) * (C b0 b123) = C (a0*b0 - a123*b123) (a0*b123 + a123*b0)+ -- log (I a123 + R (sqrt $ 1 + a123^2) *+ -- C ((cos (atan2 a123 1 / 2))*(cos (atan2 a123 (-1) / 2)) - (sin (atan2 a123 1 / 2))*(sin (atan2 a123 (-1) / 2)))+ -- ((cos (atan2 a123 1 / 2))*(sin (atan2 a123 (-1) / 2)) + (sin (atan2 a123 1 / 2))*(cos (atan2 a123 (-1) / 2))) )+ --+ -- Solution now branches for positive and negative a123+ --+ -- For a123 > 0 Substitute (cos (atan2 a123 (-1) / 2)) == (sin (atan2 a123 1 / 2)) AND+ -- (sin (atan2 a123 (-1) / 2)) == (cos (atan2 a123 1 / 2)) AND+ -- atan2 a123 1 == atan a123+ -- log (I a123 + R (sqrt $ 1 + a123^2) *+ -- C ((cos (atan a123 / 2))*(sin (atan a123 / 2)) - (sin (atan a123 / 2))*(cos (atan a123 / 2)))+ -- ((cos (atan a123 / 2))*(cos (atan a123 / 2)) + (sin (atan a123 / 2))*(sin (atan a123 / 2))) )+ -- sin^2 + cos^2 == 1 AND cos*sin - sin*cos == 0 AND Reduce C 0 1 to I 1 AND apply (*) AND apply (+)+ -- log (I (a123 + sqrt (1 + a123^2)))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- C (log.abs $ (a123 + sqrt (1 + a123^2))) (signum (a123 + sqrt (1 + a123^2)) * (pi/2))+ -- With a123 positive Apply signum:+ -- C (log.abs $ (a123 + sqrt (1 + a123^2))) (pi/2)+ | a123 > 0 = C (log.abs $ (a123 + sqrt (1 + a123^2))) (pi/2)+ -- With a123 == 0:+ -- reduce C 0 (pi/2)+ -- I (pi/2)+ | a123 == 0 = I (pi/2)+ -- For a123 < 0 Substitute (cos (atan2 a123 (-1) / 2)) == (negate.sin $ (atan2 a123 1 / 2)) AND+ -- (sin (atan2 a123 (-1) / 2)) == (negate.cos $ (atan2 a123 1 / 2)) AND+ -- atan2 a123 1 == atan a123+ -- log (I a123 + R (sqrt $ 1 + a123^2) *+ -- C ((cos (atan2 a123 1 / 2))*(negate.sin $ (atan2 a123 1 / 2)) - (sin (atan2 a123 1 / 2))*(negate.cos $ (atan2 a123 1 / 2)))+ -- ((cos (atan2 a123 1 / 2))*(negate.cos $ (atan2 a123 1 / 2)) + (sin (atan2 a123 1 / 2))*(negate.sin $ (atan2 a123 1 / 2))) )+ -- Factor negate out AND sin^2 + cos^2 == 1 AND cos*sin - sin*cos == 0 AND Reduce C 0 (-1) to I (-1) AND apply (*) AND apply (+)+ -- log (I (a123 - sqrt (1 + a123^2)))+ -- Def ==> log (I a123) = C (log.abs $ a123) (signum a123 * (pi/2))+ -- C (log.abs $ (a123 - sqrt (1 + a123^2))) (signum (a123 - sqrt (1 + a123^2)) * (pi/2))+ -- With a123 negateive Apply signum:+ -- C (log.abs $ (a123 - sqrt (1 + a123^2))) (-pi/2)+ | otherwise = C (log.abs $ (a123 - sqrt (1 + a123^2))) (-pi/2)+ --+ acosh (C a0 a123) =+ -- log (C a0 a123 + sqrt(C (a0+1) a123) * sqrt(C (a0-1) a123))+ -- Def ==> sqrt (C a0 a123) =+ -- C ((sqrt.sqrt $ a0^2 + a123^2) * cos (atan2 a123 a0 / 2))+ -- ((sqrt.sqrt $ a0^2 + a123^2) * sin (atan2 a123 a0 / 2))+ -- log (C a0 a123 ++ -- C ((sqrt.sqrt $ (a0+1)^2 + a123^2) * cos (atan2 a123 (a0+1) / 2))+ -- ((sqrt.sqrt $ (a0+1)^2 + a123^2) * sin (atan2 a123 (a0+1) / 2)) *+ -- C ((sqrt.sqrt $ (a0-1)^2 + a123^2) * cos (atan2 a123 (a0-1) / 2))+ -- ((sqrt.sqrt $ (a0-1)^2 + a123^2) * sin (atan2 a123 (a0-1) / 2)) )+ -- Factor out the scalar in both Complex numbers+ -- log (C a0 a123 ++ -- R (sqrt.sqrt $ (a0+1)^2 + a123^2) *+ -- C (cos (atan2 a123 (a0+1) / 2)) (sin (atan2 a123 (a0+1) / 2)) *+ -- R (sqrt.sqrt $ (a0-1)^2 + a123^2) *+ -- C (cos (atan2 a123 (a0-1) / 2)) (sin (atan2 a123 (a0-1) / 2)) )+ -- Combine the R terms+ -- log (C a0 a123 ++ -- R (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) *+ -- C (cos (atan2 a123 (a0+1) / 2)) (sin (atan2 a123 (a0+1) / 2)) *+ -- C (cos (atan2 a123 (a0-1) / 2)) (sin (atan2 a123 (a0-1) / 2)) )+ -- Def ==> (C a0 a123) * (C b0 b123) = C (a0*b0 - a123*b123)+ -- (a0*b123 + a123*b0)+ -- log (C a0 a123 ++ -- R (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) *+ -- C (((cos (atan2 a123 (a0+1) / 2))*(cos (atan2 a123 (a0-1) / 2))) - ((sin (atan2 a123 (a0+1) / 2))*(sin (atan2 a123 (a0-1) / 2))))+ -- (((cos (atan2 a123 (a0+1) / 2))*(sin (atan2 a123 (a0-1) / 2))) + ((sin (atan2 a123 (a0+1) / 2))*(cos (atan2 a123 (a0-1) / 2)))) )+ -- =+ -- log (C a0 a123 ++ -- R (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) *+ -- C (cos(0.5*(atan2 a123 (a0+1) + atan2 a123 (a0-1))))+ -- (sin(0.5*(atan2 a123 (a0-1) + atan2 a123 (a0+1)))) )+ -- Apply (*)+ -- log (C a0 a123 ++ -- C ((sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) *(cos(0.5*(atan2 a123 (a0+1) + atan2 a123 (a0-1)))))+ -- ((sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) *(sin(0.5*(atan2 a123 (a0-1) + atan2 a123 (a0+1))))) )+ -- Apply (+)+ -- log (C (a0 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((cos(0.5*(atan2 a123 (a0+1) + atan2 a123 (a0-1))))))+ -- (a123 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((sin(0.5*(atan2 a123 (a0-1) + atan2 a123 (a0+1)))))) )+ -- Def ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- = C (log.sqrt $ (a0 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((cos(0.5*(atan2 a123 (a0+1) + atan2 a123 (a0-1))))))^2 + (a123 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((sin(0.5*(atan2 a123 (a0-1) + atan2 a123 (a0+1))))))^2) + -- (atan2 (a123 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((sin(0.5*(atan2 a123 (a0-1) + atan2 a123 (a0+1)))))) (a0 + (sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)) * ((cos(0.5*(atan2 a123 (a0+1) + atan2 a123 (a0-1)))))))+ -- Collect like terms:+ let theta = atan2 a123 (a0+1) + atan2 a123 (a0-1)+ rho = sqrt.sqrt $ ((a0+1)^2 + a123^2) * ((a0-1)^2 + a123^2)+ b0 = a0 + rho * cos(theta/2)+ b123 = a123 + rho * sin(theta/2)+ in C (log (b0^2 + b123^2) / 2) (atan2 b123 b0)+ --+ acosh cliffor = spectraldcmp acosh acosh' cliffor++ --+ atanh (R a0)+ -- = 0.5*log (R (1+a0)) - 0.5*log (R (1-a0))+ -- = (R ((0.5*).log $ 1+a0)) - (C ((0.5*).log.negate $ 1-a0) (pi/2))+ -- = C (((0.5*).log $ 1+a0) - ((0.5*).log.negate $ 1-a0)) (-pi/2)+ -- = C (0.5*((log $ 1+a0) - (log $ a0-1))) (-pi/2)+ | a0 > 1 = C ((log (1+a0) - log (a0-1))/2) (-pi/2)+ -- = 0.5 * (log (R (1+a0)) - log (R (1-a0)))+ -- = 0.5*(R (log $ 1+a0) - R (log $ 1-a0))+ -- = R (0.5*(log $ 1+a0) - 0.5*(log $ 1-a0))+ -- = R (atanh a0)+ | a0 >= (-1) = R (atanh a0)+ -- = 0.5 * (log (R (1+a0)) - log (R (1-a0)))+ -- = (C ((0.5*).log.negate $ 1+a0) (pi/2)) - (R ((0.5*).log $ 1-a0))+ -- = C (((0.5*).log.negate $ 1+a0) - ((0.5*).log $ 1-a0)) (pi/2)+ -- = C (0.5*((log.negate $ 1+a0) - (log $ 1-a0))) (pi/2)+ | otherwise = C (((log.negate $ 1+a0) - log (1-a0))/2) (pi/2)+ --+ -- For I:+ -- = 0.5 * (log (C 1 a123) - log (C 1 (-a123)))+ -- = I (atan a123)+ atanh (I a123)+ | a123 == 0 = R 0+ | otherwise = I (atan a123)+ -- = 0.5 * (log (C (1+a0) a123) - log (C (1-a0) (-a123)))+ -- Def log ==> log (C a0 a123) = C (log.sqrt $ a0^2 + a123^2) (atan2 a123 a0)+ -- log (C (1+a0) a123) = C (log.sqrt $ (1+a0)^2 + a123^2) (atan2 a123 (1+a0))+ -- log (C (1-a0) (-a123)) = C (log.sqrt $ (1-a0)^2 + (-a123)^2) (atan2 (-a123) (1-a0))+ -- = C (((0.5*).log.sqrt $ (1+a0)^2 + a123^2) - ((0.5*).log.sqrt $ (1-a0)^2 + a123^2)) (0.5*((atan2 a123 (1+a0)) - (atan2 (-a123) (1-a0))))+ -- C (((log $ (1+a0)^2 + a123^2) - (log $ (1-a0)^2 + a123^2))/4) (((atan2 a123 (1-a0)) + (atan2 a123 (1+a0)))/2)+ atanh (C a0 a123) = C ((log ((1+a0)^2 + a123^2) - log ((1-a0)^2 + a123^2))/4) ((atan2 a123 (1-a0) + atan2 a123 (1+a0))/2)+ --+ atanh cliffor = spectraldcmp atanh atanh' cliffor++++-- |'lsv' the littlest singular value. Useful for testing for invertability.+lsv :: Cl3 -> Cl3+lsv (R a0) = R (abs a0) -- absolute value of a real number+lsv (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2)) -- magnitude of a vector+lsv (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2)) -- magnitude of a bivector+lsv (I a123) = R (abs a123)+lsv (PV a0 a1 a2 a3) = R (loDisc a0 a1 a2 a3)+lsv (TPV a23 a31 a12 a123) = R (loDisc a123 a23 a31 a12)+lsv (H a0 a23 a31 a12) = R (sqrt (a0^2 + a23^2 + a31^2 + a12^2))+lsv (C a0 a123) = R (sqrt (a0^2 + a123^2)) -- magnitude of a complex number+lsv (BPV a1 a2 a3 a23 a31 a12) =+ let x = negate.sqrt $ (a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2 -- core was duplicating this computation added let to hopefully reduce the duplication+ y = a1^2 + a23^2 + a2^2 + x + a31^2 + a3^2 + a12^2 + x -- attempted to balance out the sum of several positives with a negitive before the next sum of positives and negitive+ in if y <= tol' -- gaurd for numerical errors, y could be negative with large enough biparavectors+ then R 0+ else R (sqrt y)+lsv (ODD a1 a2 a3 a123) = R (sqrt (a1^2 + a2^2 + a3^2 + a123^2))+lsv (APS a0 a1 a2 a3 a23 a31 a12 a123) =+ let x = negate.sqrt $ (a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 ++ (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2 -- core was duplicating this computation added let to hopefully reduce the duplication+ y = a0^2 + a1^2 + a2^2 + a3^2 + x + a23^2 + a31^2 + a12^2 + a123^2 + x -- attempted to balance out the sum of several positives with a negitive before the next sum of positives and negitive+ in if y <= tol' -- gaurd for numerical errors, y could be negative with large enough cliffors+ then R 0+ else R (sqrt y)+++-- | 'loDisc' The Lower Discriminant for Paravectors and Triparavectors, real and imagninary portions of APS+loDisc :: Double -> Double -> Double -> Double -> Double+loDisc v0 v1 v2 v3 =+ let sumsqs = v1^2 + v2^2 + v3^2+ x = negate $ abs v0 * sqrt sumsqs+ y = v0^2 + x + sumsqs + x+ in if y <= tol' -- gaurd for numerical errors, y could be negative with large enough paravectors+ then 0+ else sqrt y+++-- | 'spectraldcmp' the spectral decomposition of a function to calculate analytic functions of cliffors in Cl(3,0).+-- This function requires the desired function's R, I, and C instances to be calculated and the function's derivative.+-- If multiple functions are being composed, its best to pass the composition of the funcitons+-- to this function and the derivative to this function. Any function with a Taylor Series+-- approximation should be able to be used. A real, imaginary, and complex version of the function to be decomposed+-- must be provided and spectraldcmp will handle the case for an arbitrary Cliffor.+-- +-- It may be possible to add, in the future, a RULES pragma like:+--+-- > "spectral decomposition function composition"+-- > forall f f' g g' cliff.+-- > spectraldcmp f f' (spectraldcmp g g' cliff) = spectraldcmp (f.g) (f'.g') cliff+-- +-- +spectraldcmp :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3+spectraldcmp fun fun' (reduce -> cliffor) = dcmp cliffor+ where+ dcmp r@R{} = fun r+ dcmp i@I{} = fun i+ dcmp c@C{} = fun c+ dcmp v@V3{} = spectraldcmpSpecial toR fun v -- spectprojR fun v+ dcmp pv@PV{} = spectraldcmpSpecial toR fun pv -- spectprojR fun pv+ dcmp bv@BV{} = spectraldcmpSpecial toI fun bv -- spectprojI fun bv+ dcmp tpv@TPV{} = spectraldcmpSpecial toI fun tpv -- spectprojI fun tpv+ dcmp h@H{} = spectraldcmpSpecial toC fun h -- spectprojC fun h+ dcmp od@ODD{} = spectraldcmpSpecial toC fun od -- spectprojC fun od+ dcmp cliff+ | hasNilpotent cliff = jordan toC fun fun' cliff -- jordan normal form Cl3 style+ | isColinear cliff = spectraldcmpSpecial toC fun cliff -- spectprojC fun bpv+ | otherwise = -- transform it so it will be colinear+ let (BPV a1 a2 a3 a23 a31 a12) = toBPV cliff+ boost = boost2colinear a1 a2 a3 a23 a31 a12+ in boost * spectraldcmpSpecial toC fun (bar boost * cliff * boost) * bar boost -- v * spectprojC fun d * v_bar+--+++-- | 'jordan' does a Cl(3,0) version of the decomposition into Jordan Normal Form and Matrix Function Calculation+-- The intended use is for calculating functions for cliffors with vector parts simular to Nilpotent.+-- It is a helper function for 'spectraldcmp'. It is fortunate because eigen decomposition doesn't+-- work with elements with nilpotent content, so it fills the gap.+jordan :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3+jordan toSpecial fun fun' cliffor =+ let eigs = toSpecial cliffor+ in fun eigs + fun' eigs * toBPV cliffor++-- | 'spectraldcmpSpecial' helper function for with specialization for real, imaginary, or complex eigenvalues.+-- To specialize for Reals pass 'toR', to specialize for Imaginary pass 'toI', to specialize for Complex pass 'toC'+spectraldcmpSpecial :: (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> Cl3 -> Cl3+spectraldcmpSpecial toSpecial function cliffor =+ let (p,p_bar,eig1,eig2) = projEigs toSpecial cliffor+ in function eig1 * p + function eig2 * p_bar++++-- | 'eigvals' calculates the eignenvalues of the cliffor.+-- This is useful for determining if a cliffor is the pole+-- of a function.+eigvals :: Cl3 -> (Cl3,Cl3)+eigvals (reduce -> cliffor) = eigv cliffor+ where+ eigv r@R{} = dup r+ eigv i@I{} = dup i+ eigv c@C{} = dup c+ eigv v@V3{} = eigvalsSpecial toR v -- eigvalsR v+ eigv pv@PV{} = eigvalsSpecial toR pv -- eigvalsR pv+ eigv bv@BV{} = eigvalsSpecial toI bv -- eigvalsI bv+ eigv tpv@TPV{} = eigvalsSpecial toI tpv -- eigvalsI tpv+ eigv h@H{} = eigvalsSpecial toC h -- eigvalsC h+ eigv od@ODD{} = eigvalsSpecial toC od -- eigvalsC od+ eigv cliff+ | hasNilpotent cliff = dup.reduce.toC $ cliff -- this case is actually nilpotent+ | isColinear cliff = eigvalsSpecial toC cliff -- eigvalsC bpv+ | otherwise = -- transform it so it will be colinear+ let (BPV a1 a2 a3 a23 a31 a12) = toBPV cliff+ boost = boost2colinear a1 a2 a3 a23 a31 a12+ in eigvalsSpecial toC (bar boost * cliff * boost) -- eigvalsC d+--+++dup :: Cl3 -> (Cl3,Cl3)+dup cliff = (cliff, cliff)++-- | 'eigvalsSpecial' helper function to calculate Eigenvalues+eigvalsSpecial :: (Cl3 -> Cl3) -> Cl3 -> (Cl3,Cl3)+eigvalsSpecial toSpecial cliffor =+ let (_,_,eig1,eig2) = projEigs toSpecial cliffor+ in (eig1,eig2)+++-- | 'project' makes a projector based off of the vector content of the Cliffor.+project :: Cl3 -> Cl3 -- PV<:Cl3+project R{} = PV 0.5 0 0 0.5 -- default to e3 direction+project I{} = PV 0.5 0 0 0.5 -- default to e3 direction+project C{} = PV 0.5 0 0 0.5 -- default to e3 direction+project (V3 a1 a2 a3) = triDProj a1 a2 a3 -- proj v@V3{} = 0.5 + 0.5*signum v+project (PV _ a1 a2 a3) = triDProj a1 a2 a3 -- proj pv@PV{} = 0.5 + 0.5*(signum.toV3 $ pv)+project (ODD a1 a2 a3 _) = triDProj a1 a2 a3 -- od@ODD{} = 0.5 + 0.5*(signum.toV3 $ od)+project (BV a23 a31 a12) = triDProj a23 a31 a12 -- bv@BV{} = 0.5 + 0.5*(mIx.signum $ bv)+project (H _ a23 a31 a12) = triDProj a23 a31 a12 -- h@H{} = 0.5 + 0.5*(mIx.signum.toBV $ h)+project (TPV a23 a31 a12 _) = triDProj a23 a31 a12 -- tpv@TPV{} = 0.5 + 0.5*(mIx.signum.toBV $ tpv)+project (BPV a1 a2 a3 a23 a31 a12) = biTriDProj a1 a2 a3 a23 a31 a12+project (APS _ a1 a2 a3 a23 a31 a12 _) = biTriDProj a1 a2 a3 a23 a31 a12++++-- If Dot product is negative or zero we have a problem, if it is zero+-- it either the vector or bivector par is zero or they are orthognal+-- if the dot product is negative the vectors could be antiparallel+biTriDProj :: Double -> Double -> Double -> Double -> Double -> Double -> Cl3 -- PV<:Cl3+biTriDProj a1 a2 a3 a23 a31 a12 =+ let v3Mag = sqrt $ a1^2 + a2^2 + a3^2+ v3MagltTol = v3Mag < tol'+ halfInvV3Mag = recip v3Mag / 2+ bvMag = sqrt $ a23^2 + a31^2 + a12^2+ bvMagltTol = bvMag < tol'+ halfInvBVMag = recip bvMag / 2+ dotPos = (a1*a23) + (a2*a31) + (a3*a12) >= 0+ b1 = a1 + a23+ b2 = a2 + a31+ b3 = a3 + a12+ bHalfInvMag = (/2).recip.sqrt $ b1^2 + b2^2 + b3^2+ c1 = a1 - a23+ c2 = a2 - a31+ c3 = a3 - a12+ cHalfInvMag = (/2).recip.sqrt $ c1^2 + c2^2 + c3^2+ in if | v3MagltTol && bvMagltTol -> PV 0.5 0 0 0.5+ | bvMagltTol -> PV 0.5 (halfInvV3Mag * a1) (halfInvV3Mag * a2) (halfInvV3Mag * a3)+ | v3MagltTol -> PV 0.5 (halfInvBVMag * a23) (halfInvBVMag * a31) (halfInvBVMag * a12)+ | dotPos -> PV 0.5 (bHalfInvMag * b1) (bHalfInvMag * b2) (bHalfInvMag * b3)+ | otherwise -> PV 0.5 (cHalfInvMag * c1) (cHalfInvMag * c2) (cHalfInvMag * c3)+++-- | 'triDProj' a single 3 dimensional vector grade to a projector+triDProj :: Double -> Double -> Double -> Cl3 -- PV<:Cl3+triDProj v1 v2 v3 =+ let mag = sqrt $ v1^2 + v2^2 + v3^2+ halfInvMag = recip mag / 2+ in if mag == 0+ then PV 0.5 0 0 0.5+ else PV 0.5 (halfInvMag * v1) (halfInvMag * v2) (halfInvMag * v3)+++-- | 'boost2colinear' calculates a boost that is perpendicular to both the vector and bivector+-- components of the cliffor, that will mix the vector and bivector parts such that the vector and bivector+-- parts become colinear. This function is a simularity transform such that:+--+-- > cliffor = boost * colinear * bar boost+--+-- and returns the boost given the inputs. First the boost must be calculated+-- and then+--+-- > colinear = bar boost * cliffor * boost+--+-- and colinear will have colinear vector and bivector parts of the cliffor.+-- This is somewhat simular to finding the drift frame for a static electromagnetic field.+--+-- > v = toV3 cliffor -- extract the vector+-- > bv = mIx.toBV $ cliffor -- extract the bivector and turn it into a vector+-- > invariant = ((2*).mIx.toBV $ v * bv) / (toR (v^2) + toR (bv^2))+-- > boost = spectraldcmpSpecial toR (exp.(/4).atanh) invariant+--+boost2colinear :: Double -> Double -> Double -> Double -> Double -> Double -> Cl3 -- PV<:Cl3+boost2colinear a1 a2 a3 a23 a31 a12 =+ let scale = recip $ a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2+ b1 = scale * (a2*a12 - a3*a31)+ b2 = scale * (a3*a23 - a1*a12)+ b3 = scale * (a1*a31 - a2*a23)+ eig1 = (2*).sqrt $ b1^2 + b2^2 + b3^2+ eig2 = negate eig1+ transEig1 = exp.(/4).atanh $ eig1+ transEig2 = exp.(/4).atanh $ eig2+ sumTransEigs = (transEig1 - transEig2) * recip eig1+ in PV (0.5 * (transEig1 + transEig2)) (sumTransEigs * b1) (sumTransEigs * b2) (sumTransEigs * b3)+++-- | 'isColinear' takes a Cliffor and determines if either the vector part or the bivector part are+-- zero or both aligned in the same direction.+isColinear :: Cl3 -> Bool+isColinear R{} = True+isColinear V3{} = True+isColinear BV{} = True+isColinear I{} = True+isColinear PV{} = True+isColinear H{} = True+isColinear C{} = True+isColinear ODD{} = True+isColinear TPV{} = True+isColinear (BPV a1 a2 a3 a23 a31 a12) = colinearHelper a1 a2 a3 a23 a31 a12+isColinear (APS _ a1 a2 a3 a23 a31 a12 _) = colinearHelper a1 a2 a3 a23 a31 a12++colinearHelper :: Double -> Double -> Double -> Double -> Double -> Double -> Bool+colinearHelper a1 a2 a3 a23 a31 a12 =+ let magV3 = sqrt $ a1^2 + a2^2 + a3^2+ invMagV3 = recip magV3+ magBV = sqrt $ a23^2 + a31^2 + a12^2+ invMagBV = recip magBV+ crss = sqrt (((invMagV3 * a2)*(invMagBV * a12) - (invMagV3 * a3)*(invMagBV * a31))^2 ++ ((invMagV3 * a3)*(invMagBV * a23) - (invMagV3 * a1)*(invMagBV * a12))^2 ++ ((invMagV3 * a1)*(invMagBV * a31) - (invMagV3 * a2)*(invMagBV * a23))^2)+ in magV3 == 0 || -- Zero Vector+ magBV == 0 || -- Zero Bivector+ crss <= tol' -- Orthoganl part is zero-ish+++-- | 'hasNilpotent' takes a Cliffor and determines if the vector part and the bivector part are+-- orthoganl and equal in magnitude, i.e. that it is simular to a nilpotent BPV.+hasNilpotent :: Cl3 -> Bool+hasNilpotent R{} = False+hasNilpotent V3{} = False+hasNilpotent BV{} = False+hasNilpotent I{} = False+hasNilpotent PV{} = False+hasNilpotent H{} = False+hasNilpotent C{} = False+hasNilpotent ODD{} = False+hasNilpotent TPV{} = False+hasNilpotent (BPV a1 a2 a3 a23 a31 a12) = nilpotentHelper a1 a2 a3 a23 a31 a12+hasNilpotent (APS _ a1 a2 a3 a23 a31 a12 _) = nilpotentHelper a1 a2 a3 a23 a31 a12++nilpotentHelper :: Double -> Double -> Double -> Double -> Double -> Double -> Bool+nilpotentHelper a1 a2 a3 a23 a31 a12 =+ let magV3 = sqrt $ a1^2 + a2^2 + a3^2+ invMagV3 = recip magV3+ magBV = sqrt $ a23^2 + a31^2 + a12^2+ invMagBV = recip magV3+ magDiff = abs (magV3 - magBV)+ b1 = invMagV3 * a1+ b2 = invMagV3 * a2+ b3 = invMagV3 * a3+ b23 = invMagBV * a23+ b31 = invMagBV * a31+ b12 = invMagBV * a12+ c0 = b1*b1 + b2*b2 + b3*b3 - b23*b23 - b31*b31 - b12*b12+ c1 = b12*b2 - b2*b12 + b3*b31 - b31*b3+ c2 = b1*b12 - b12*b1 - b3*b23 + b23*b3+ c3 = b31*b1 - b1*b31 + b2*b23 - b23*b2+ c23 = b2*b3 - b3*b2 - b31*b12 + b12*b31+ c31 = b3*b1 - b1*b3 + b23*b12 - b12*b23+ c12 = b1*b2 - b2*b1 - b23*b31 + b31*b23+ c123 = b1*b23 + b23*b1 + b2*b31 + b31*b2 + b3*b12 + b12*b3+ x = sqrt ((c0*c1 + c123*c23)^2 + (c0*c2 + c123*c31)^2 + (c0*c3 + c123*c12)^2 ++ (c2*c12 - c3*c31)^2 + (c3*c23 - c1*c12)^2 + (c1*c31 - c2*c23)^2)+ sqMag = sqrt (c0^2 + c1^2 + c2^2 + c3^2 + c23^2 + c31^2 + c12^2 + c123^2 + x + x)+ in magV3 /= 0 && -- Non-Zero Vector Part+ magBV /= 0 && -- Non-Zero Bivector Part+ magDiff <= tol' && -- Vector and Bivector are Equal Magnitude+ sqMag <= tol' -- It's non-zero but squares to zero+++-- | 'projEigs' function returns complementary projectors and eigenvalues for a Cliffor with specialization.+-- The Cliffor at this point is allready colinear and the Eigenvalue is known to be real, imaginary, or complex.+projEigs :: (Cl3 -> Cl3) -> Cl3 -> (Cl3,Cl3,Cl3,Cl3)+projEigs toSpecial cliffor =+ let p = project cliffor+ p_bar = bar p+ eig1 = 2 * toSpecial (p * cliffor * p)+ eig2 = 2 * toSpecial (p_bar * cliffor * p_bar)+ in (p,p_bar,eig1,eig2)++-- | 'reduce' function reduces the number of grades in a specialized Cliffor if they+-- are zero-ish+reduce :: Cl3 -> Cl3+reduce cliff+ | abs cliff <= tol = R 0+ | otherwise = go_reduce cliff+ where+ go_reduce r@R{} = r+ go_reduce v@V3{} = v+ go_reduce bv@BV{} = bv+ go_reduce i@I{} = i+ go_reduce pv@PV{}+ | abs (toV3 pv) <= tol = toR pv+ | abs (toR pv) <= tol = toV3 pv+ | otherwise = pv+ go_reduce h@H{}+ | abs (toBV h) <= tol = toR h+ | abs (toR h) <= tol = toBV h+ | otherwise = h+ go_reduce c@C{}+ | abs (toI c) <= tol = toR c+ | abs (toR c) <= tol = toI c+ | otherwise = c+ go_reduce bpv@BPV{}+ | abs (toBV bpv) <= tol = toV3 bpv+ | abs (toV3 bpv) <= tol = toBV bpv+ | otherwise = bpv+ go_reduce od@ODD{}+ | abs (toI od) <= tol = toV3 od+ | abs (toV3 od) <= tol = toI od+ | otherwise = od+ go_reduce tpv@TPV{}+ | abs (toBV tpv) <= tol = toI tpv+ | abs (toI tpv) <= tol = toBV tpv+ | otherwise = tpv+ go_reduce aps@APS{}+ | abs (toBPV aps) <= tol = go_reduce (toC aps)+ | abs (toODD aps) <= tol = go_reduce (toH aps)+ | abs (toTPV aps) <= tol = go_reduce (toPV aps)+ | abs (toC aps) <= tol = go_reduce (toBPV aps)+ | abs (toH aps) <= tol = go_reduce (toODD aps)+ | abs (toPV aps) <= tol = go_reduce (toTPV aps)+ | otherwise = aps+++-- | 'mIx' a more effecient '\x -> I (-1) * x' typically useful for converting a+-- Bivector to a Vector in the same direction. Related to Hodge Dual and/or+-- Inverse Hodge Star.+mIx :: Cl3 -> Cl3+mIx (R a0) = I (negate a0)+mIx (V3 a1 a2 a3) = BV (negate a1) (negate a2) (negate a3)+mIx (BV a23 a31 a12) = V3 a23 a31 a12+mIx (I a123) = R a123+mIx (PV a0 a1 a2 a3) = TPV (negate a1) (negate a2) (negate a3) (negate a0)+mIx (H a0 a23 a31 a12) = ODD a23 a31 a12 (negate a0)+mIx (C a0 a123) = C a123 (negate a0)+mIx (BPV a1 a2 a3 a23 a31 a12) = BPV a23 a31 a12 (negate a1) (negate a2) (negate a3)+mIx (ODD a1 a2 a3 a123) = H a123 (negate a1) (negate a2) (negate a3)+mIx (TPV a23 a31 a12 a123) = PV a123 a23 a31 a12+mIx (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a123 a23 a31 a12 (negate a1) (negate a2) (negate a3) (negate a0)++-- | 'timesI' is a more effecient '\x -> I 1 * x'+timesI :: Cl3 -> Cl3+timesI (R a0) = I a0+timesI (V3 a1 a2 a3) = BV a1 a2 a3+timesI (BV a23 a31 a12) = V3 (negate a23) (negate a31) (negate a12)+timesI (I a123) = R (negate a123)+timesI (PV a0 a1 a2 a3) = TPV a1 a2 a3 a0+timesI (H a0 a23 a31 a12) = ODD (negate a23) (negate a31) (negate a12) a0+timesI (C a0 a123) = C (negate a123) a0+timesI (BPV a1 a2 a3 a23 a31 a12) = BPV (negate a23) (negate a31) (negate a12) a1 a2 a3+timesI (ODD a1 a2 a3 a123) = H (negate a123) a1 a2 a3+timesI (TPV a23 a31 a12 a123) = PV (negate a123) (negate a23) (negate a31) (negate a12)+timesI (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS (negate a123) (negate a23) (negate a31) (negate a12) a1 a2 a3 a0++-- | 'tol' currently 128*eps+tol :: Cl3+{-# INLINE tol #-}+tol = R 1.4210854715202004e-14++tol' :: Double+{-# INLINE tol' #-}+tol' = 1.4210854715202004e-14+++-- | 'bar' is a Clifford Conjugate, the vector grades are negated+bar :: Cl3 -> Cl3+bar (R a0) = R a0+bar (V3 a1 a2 a3) = V3 (negate a1) (negate a2) (negate a3)+bar (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)+bar (I a123) = I a123+bar (PV a0 a1 a2 a3) = PV a0 (negate a1) (negate a2) (negate a3)+bar (H a0 a23 a31 a12) = H a0 (negate a23) (negate a31) (negate a12)+bar (C a0 a123) = C a0 a123+bar (BPV a1 a2 a3 a23 a31 a12) = BPV (negate a1) (negate a2) (negate a3) (negate a23) (negate a31) (negate a12)+bar (ODD a1 a2 a3 a123) = ODD (negate a1) (negate a2) (negate a3) a123+bar (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12) a123+bar (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 (negate a1) (negate a2) (negate a3) (negate a23) (negate a31) (negate a12) a123++-- | 'dag' is the Complex Conjugate, the imaginary grades are negated+dag :: Cl3 -> Cl3+dag (R a0) = R a0+dag (V3 a1 a2 a3) = V3 a1 a2 a3+dag (BV a23 a31 a12) = BV (negate a23) (negate a31) (negate a12)+dag (I a123) = I (negate a123)+dag (PV a0 a1 a2 a3) = PV a0 a1 a2 a3+dag (H a0 a23 a31 a12) = H a0 (negate a23) (negate a31) (negate a12)+dag (C a0 a123) = C a0 (negate a123)+dag (BPV a1 a2 a3 a23 a31 a12) = BPV a1 a2 a3 (negate a23) (negate a31) (negate a12)+dag (ODD a1 a2 a3 a123) = ODD a1 a2 a3 (negate a123)+dag (TPV a23 a31 a12 a123) = TPV (negate a23) (negate a31) (negate a12) (negate a123)+dag (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 a1 a2 a3 (negate a23) (negate a31) (negate a12) (negate a123)++----------------------------------------------------------------------------------------------------------------+-- the to... functions provide a lossy cast from one Cl3 constructor to another+---------------------------------------------------------------------------------------------------------------+-- | 'toR' takes any Cliffor and returns the R portion+toR :: Cl3 -> Cl3+toR (R a0) = R a0+toR V3{} = R 0+toR BV{} = R 0+toR I{} = R 0+toR (PV a0 _ _ _) = R a0+toR (H a0 _ _ _) = R a0+toR (C a0 _) = R a0+toR BPV{} = R 0+toR ODD{} = R 0+toR TPV{} = R 0+toR (APS a0 _ _ _ _ _ _ _) = R a0++-- | 'toV3' takes any Cliffor and returns the V3 portion+toV3 :: Cl3 -> Cl3+toV3 R{} = V3 0 0 0+toV3 (V3 a1 a2 a3) = V3 a1 a2 a3+toV3 BV{} = V3 0 0 0+toV3 I{} = V3 0 0 0+toV3 (PV _ a1 a2 a3) = V3 a1 a2 a3+toV3 H{} = V3 0 0 0+toV3 C{} = V3 0 0 0+toV3 (BPV a1 a2 a3 _ _ _) = V3 a1 a2 a3+toV3 (ODD a1 a2 a3 _) = V3 a1 a2 a3+toV3 TPV{} = V3 0 0 0+toV3 (APS _ a1 a2 a3 _ _ _ _) = V3 a1 a2 a3++-- | 'toBV' takes any Cliffor and returns the BV portion+toBV :: Cl3 -> Cl3+toBV R{} = BV 0 0 0+toBV V3{} = BV 0 0 0+toBV (BV a23 a31 a12) = BV a23 a31 a12+toBV I{} = BV 0 0 0+toBV PV{} = BV 0 0 0+toBV (H _ a23 a31 a12) = BV a23 a31 a12+toBV C{} = BV 0 0 0+toBV (BPV _ _ _ a23 a31 a12) = BV a23 a31 a12+toBV ODD{} = BV 0 0 0+toBV (TPV a23 a31 a12 _) = BV a23 a31 a12+toBV (APS _ _ _ _ a23 a31 a12 _) = BV a23 a31 a12++-- | 'toI' takes any Cliffor and returns the I portion+toI :: Cl3 -> Cl3+toI R{} = I 0+toI V3{} = I 0+toI BV{} = I 0+toI (I a123) = I a123+toI PV{} = I 0+toI H{} = I 0+toI (C _ a123) = I a123+toI BPV{} = I 0+toI (ODD _ _ _ a123) = I a123+toI (TPV _ _ _ a123) = I a123+toI (APS _ _ _ _ _ _ _ a123) = I a123++-- | 'toPV' takes any Cliffor and returns the PV poriton+toPV :: Cl3 -> Cl3+toPV (R a0) = PV a0 0 0 0+toPV (V3 a1 a2 a3) = PV 0 a1 a2 a3+toPV BV{} = PV 0 0 0 0+toPV I{} = PV 0 0 0 0+toPV (PV a0 a1 a2 a3) = PV a0 a1 a2 a3+toPV (H a0 _ _ _) = PV a0 0 0 0+toPV (C a0 _) = PV a0 0 0 0+toPV (BPV a1 a2 a3 _ _ _) = PV 0 a1 a2 a3+toPV (ODD a1 a2 a3 _) = PV a1 a2 a3 0+toPV TPV{} = PV 0 0 0 0+toPV (APS a0 a1 a2 a3 _ _ _ _) = PV a0 a1 a2 a3++-- | 'toH' takes any Cliffor and returns the H portion+toH :: Cl3 -> Cl3+toH (R a0) = H a0 0 0 0+toH V3{} = H 0 0 0 0+toH (BV a23 a31 a12) = H 0 a23 a31 a12+toH (I _) = H 0 0 0 0+toH (PV a0 _ _ _) = H a0 0 0 0+toH (H a0 a23 a31 a12) = H a0 a23 a31 a12+toH (C a0 _) = H a0 0 0 0+toH (BPV _ _ _ a23 a31 a12) = H 0 a23 a31 a12+toH ODD{} = H 0 0 0 0+toH (TPV a23 a31 a12 _) = H 0 a23 a31 a12+toH (APS a0 _ _ _ a23 a31 a12 _) = H a0 a23 a31 a12++-- | 'toC' takes any Cliffor and returns the C portion+toC :: Cl3 -> Cl3+toC (R a0) = C a0 0+toC V3{} = C 0 0+toC BV{} = C 0 0+toC (I a123) = C 0 a123+toC (PV a0 _ _ _) = C a0 0+toC (H a0 _ _ _) = C a0 0+toC (C a0 a123) = C a0 a123+toC BPV{} = C 0 0+toC (ODD _ _ _ a123) = C 0 a123+toC (TPV _ _ _ a123) = C 0 a123+toC (APS a0 _ _ _ _ _ _ a123) = C a0 a123++-- | 'toBPV' takes any Cliffor and returns the BPV portion+toBPV :: Cl3 -> Cl3+toBPV R{} = BPV 0 0 0 0 0 0+toBPV (V3 a1 a2 a3) = BPV a1 a2 a3 0 0 0+toBPV (BV a23 a31 a12) = BPV 0 0 0 a23 a31 a12+toBPV I{} = BPV 0 0 0 0 0 0+toBPV (PV _ a1 a2 a3) = BPV a1 a2 a3 0 0 0+toBPV (H _ a23 a31 a12) = BPV 0 0 0 a23 a31 a12+toBPV C{} = BPV 0 0 0 0 0 0+toBPV (BPV a1 a2 a3 a23 a31 a12) = BPV a1 a2 a3 a23 a31 a12+toBPV (ODD a1 a2 a3 _) = BPV a1 a2 a3 0 0 0+toBPV (TPV a23 a31 a12 _) = BPV 0 0 0 a23 a31 a12+toBPV (APS _ a1 a2 a3 a23 a31 a12 _) = BPV a1 a2 a3 a23 a31 a12++-- | 'toODD' takes any Cliffor and returns the ODD portion+toODD :: Cl3 -> Cl3+toODD R{} = ODD 0 0 0 0+toODD (V3 a1 a2 a3) = ODD a1 a2 a3 0+toODD BV{} = ODD 0 0 0 0+toODD (I a123) = ODD 0 0 0 a123+toODD (PV _ a1 a2 a3) = ODD a1 a2 a3 0+toODD H{} = ODD 0 0 0 0+toODD (C _ a123) = ODD 0 0 0 a123+toODD (BPV a1 a2 a3 _ _ _) = ODD a1 a2 a3 0+toODD (ODD a1 a2 a3 a123) = ODD a1 a2 a3 a123+toODD (TPV _ _ _ a123) = ODD 0 0 0 a123+toODD (APS _ a1 a2 a3 _ _ _ a123) = ODD a1 a2 a3 a123++-- | 'toTPV' takes any Cliffor and returns the TPV portion+toTPV :: Cl3 -> Cl3+toTPV R{} = TPV 0 0 0 0+toTPV V3{} = TPV 0 0 0 0+toTPV (BV a23 a31 a12) = TPV a23 a31 a12 0+toTPV (I a123) = TPV 0 0 0 a123+toTPV PV{} = TPV 0 0 0 0+toTPV (H _ a23 a31 a12) = TPV a23 a31 a12 0+toTPV (C _ a123) = TPV 0 0 0 a123+toTPV (BPV _ _ _ a23 a31 a12) = TPV a23 a31 a12 0+toTPV (ODD _ _ _ a123) = TPV 0 0 0 a123+toTPV (TPV a23 a31 a12 a123) = TPV a23 a31 a12 a123+toTPV (APS _ _ _ _ a23 a31 a12 a123) = TPV a23 a31 a12 a123++-- | 'toAPS' takes any Cliffor and returns the APS portion+toAPS :: Cl3 -> Cl3+toAPS (R a0) = APS a0 0 0 0 0 0 0 0+toAPS (V3 a1 a2 a3) = APS 0 a1 a2 a3 0 0 0 0+toAPS (BV a23 a31 a12) = APS 0 0 0 0 a23 a31 a12 0+toAPS (I a123) = APS 0 0 0 0 0 0 0 a123+toAPS (PV a0 a1 a2 a3) = APS a0 a1 a2 a3 0 0 0 0+toAPS (H a0 a23 a31 a12) = APS a0 0 0 0 a23 a31 a12 0+toAPS (C a0 a123) = APS a0 0 0 0 0 0 0 a123+toAPS (BPV a1 a2 a3 a23 a31 a12) = APS 0 a1 a2 a3 a23 a31 a12 0+toAPS (ODD a1 a2 a3 a123) = APS 0 a1 a2 a3 0 0 0 a123+toAPS (TPV a23 a31 a12 a123) = APS 0 0 0 0 a23 a31 a12 a123+toAPS (APS a0 a1 a2 a3 a23 a31 a12 a123) = APS a0 a1 a2 a3 a23 a31 a12 a123++-- derivatives of the functions in the Fractional Class for use in Jordan NF functon implemetnation+recip' :: Cl3 -> Cl3+recip' = negate.recip.(^2) -- pole at 0++exp' :: Cl3 -> Cl3+exp' = exp++log' :: Cl3 -> Cl3+log' = recip -- pole at 0++sqrt' :: Cl3 -> Cl3+sqrt' = (/2).recip.sqrt -- pole at 0++sin' :: Cl3 -> Cl3+sin' = cos++cos' :: Cl3 -> Cl3+cos' = negate.sin++tan' :: Cl3 -> Cl3+tan' = recip.(^2).cos -- pole at pi/2*n for all integers++asin' :: Cl3 -> Cl3+asin' = recip.sqrt.(1-).(^2) -- pole at +/-1++acos' :: Cl3 -> Cl3+acos' = negate.recip.sqrt.(1-).(^2) -- pole at +/-1++atan' :: Cl3 -> Cl3+atan' = recip.(1+).(^2) -- pole at +/-i++sinh' :: Cl3 -> Cl3+sinh' = cosh++cosh' :: Cl3 -> Cl3+cosh' = sinh++tanh' :: Cl3 -> Cl3+tanh' = recip.(^2).cosh++asinh' :: Cl3 -> Cl3+asinh' = recip.sqrt.(1+).(^2) -- pole at +/-i++acosh' :: Cl3 -> Cl3+acosh' x = recip $ sqrt (x - 1) * sqrt (x + 1) -- pole at +/-1++atanh' :: Cl3 -> Cl3+atanh' = recip.(1-).(^2) -- pole at +/-1+++-------------------------------------------------------------------+-- +-- Instance of Cl3 types with the "Foreign.Storable" library.+-- +-- For use with high performance data structures like Data.Vector.Storable+-- or Data.Array.Storable+-- +-------------------------------------------------------------------++-- | Cl3 instance of Storable uses the APS constructor as its standard interface.+-- "peek" returns a cliffor constructed with APS. "poke" converts a cliffor to APS.+instance Storable Cl3 where+ sizeOf _ = 8 * sizeOf (undefined :: Double)+ alignment _ = sizeOf (undefined :: Double)+ peek ptr = do+ a0 <- peek (offset 0)+ a1 <- peek (offset 1)+ a2 <- peek (offset 2)+ a3 <- peek (offset 3)+ a23 <- peek (offset 4)+ a31 <- peek (offset 5)+ a12 <- peek (offset 6)+ a123 <- peek (offset 7)+ return $ APS a0 a1 a2 a3 a23 a31 a12 a123+ where+ offset i = (castPtr ptr :: Ptr Double) `plusPtr` (i*8)+ + poke ptr (toAPS -> APS a0 a1 a2 a3 a23 a31 a12 a123) = do+ poke (offset 0) a0+ poke (offset 1) a1+ poke (offset 2) a2+ poke (offset 3) a3+ poke (offset 4) a23+ poke (offset 5) a31+ poke (offset 6) a12+ poke (offset 7) a123+ where+ offset i = (castPtr ptr :: Ptr Double) `plusPtr` (i*8)+ poke _ _ = error "Serious Issues with poke in Cl3.Storable"+++++#ifndef O_NO_RANDOM+-------------------------------------------------------------------+-- +-- Random Instance of Cl3 types with the "System.Random" library.+-- +--+-- Random helper functions will be based on the "abs x * signum x" decomposition+-- for the single grade elements. The "abs x" will be the random magnitude that+-- is by the default [0,1), and the "signum x" part will be a random direction+-- of a vector or the sign of a scalar. The multi-grade elements will be constructed from+-- a combination of the single grade generators. Each grade will be evenly+-- distributed across the range.+-- +-------------------------------------------------------------------++-- | 'Random' instance for the 'System.Random' library+instance Random Cl3 where+ randomR (minAbs,maxAbs) g =+ case randomR (fromEnum (minBound :: ConCl3), fromEnum (maxBound :: ConCl3)) g of+ (r, g') -> case toEnum r of+ ConR -> rangeR (minAbs,maxAbs) g'+ ConV3 -> rangeV3 (minAbs,maxAbs) g'+ ConBV -> rangeBV (minAbs,maxAbs) g'+ ConI -> rangeI (minAbs,maxAbs) g'+ ConPV -> rangePV (minAbs,maxAbs) g'+ ConH -> rangeH (minAbs,maxAbs) g'+ ConC -> rangeC (minAbs,maxAbs) g'+ ConBPV -> rangeBPV (minAbs,maxAbs) g'+ ConODD -> rangeODD (minAbs,maxAbs) g'+ ConTPV -> rangeTPV (minAbs,maxAbs) g'+ ConAPS -> rangeAPS (minAbs,maxAbs) g'+ ConProj -> rangeProjector (minAbs,maxAbs) g'+ ConNilpotent -> rangeNilpotent (minAbs,maxAbs) g'+ ConUnitary -> rangeUnitary (minAbs,maxAbs) g'++ random = randomR (0,1)++++-- | 'ConCl3' Bounded Enum Algebraic Data Type of constructors of Cl3+data ConCl3 = ConR+ | ConV3+ | ConBV+ | ConI+ | ConPV+ | ConH+ | ConC+ | ConBPV+ | ConODD+ | ConTPV+ | ConAPS+ | ConProj+ | ConNilpotent+ | ConUnitary+ deriving (Bounded, Enum)+++++-- | 'randR' random Real Scalar (Grade 0) with random magnitude and random sign+randR :: RandomGen g => g -> (Cl3, g)+randR = rangeR (0,1)+++-- | 'rangeR' random Real Scalar (Grade 0) with random magnitude within a range and a random sign+rangeR :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeR = scalarHelper R+++-- | 'randV3' random Vector (Grade 1) with random magnitude and random direction+-- the direction is using spherical coordinates+randV3 :: RandomGen g => g -> (Cl3, g)+randV3 = rangeV3 (0,1)+++-- | 'rangeV3' random Vector (Grade 1) with random magnitude within a range and a random direction+rangeV3 :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeV3 = vectorHelper V3+++-- | 'randBV' random Bivector (Grade 2) with random magnitude and random direction+-- the direction is using spherical coordinates+randBV :: RandomGen g => g -> (Cl3, g)+randBV = rangeBV (0,1)+++-- | 'rangeBV' random Bivector (Grade 2) with random magnitude in a range and a random direction+rangeBV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeBV = vectorHelper BV+++-- | 'randI' random Imaginary Scalar (Grade 3) with random magnitude and random sign+randI :: RandomGen g => g -> (Cl3, g)+randI = rangeI (0,1)+++-- | 'rangeI' random Imaginary Scalar (Grade 3) with random magnitude within a range and random sign+rangeI :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeI = scalarHelper I+++-- | 'randPV' random Paravector made from random Grade 0 and Grade 1 elements+randPV :: RandomGen g => g -> (Cl3, g)+randPV = rangePV (0,1)+++-- | 'rangePV' random Paravector made from random Grade 0 and Grade 1 elements within a range+rangePV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangePV (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (R a0, g'') = randR g'+ (V3 a1 a2 a3, g''') = randV3 g''+ sumsqs = a1^2 + a2^2 + a3^2+ x = abs a0 * sqrt sumsqs+ invMag = recip.sqrt $ a0^2 + sumsqs + x + x+ mag = scale * invMag+ in (PV (mag * a0) (mag * a1) (mag * a2) (mag * a3), g''')+++-- | 'randH' random Quaternion made from random Grade 0 and Grade 2 elements+randH :: RandomGen g => g -> (Cl3, g)+randH = rangeH (0,1)+++-- | 'rangeH' random Quaternion made from random Grade 0 and Grade 2 elements within a range+rangeH :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeH (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (R a0, g'') = randR g'+ (BV a23 a31 a12, g''') = randBV g''+ invMag = recip.sqrt $ a0^2 + a23^2 + a31^2 + a12^2+ mag = scale * invMag+ in (H (mag * a0) (mag * a23) (mag * a31) (mag * a12), g''')+++-- | 'randC' random combination of Grade 0 and Grade 3+randC :: RandomGen g => g -> (Cl3, g)+randC = rangeC (0,1)+++-- | 'rangeC' random combination of Grade 0 and Grade 3 within a range+rangeC :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeC (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (phi, g'') = randomR (0, 2*pi) g'+ in (C (scale * cos phi) (scale * sin phi), g'')+++-- | 'randBPV' random combination of Grade 1 and Grade 2+randBPV :: RandomGen g => g -> (Cl3, g)+randBPV = rangeBPV (0,1)+++-- | 'rangeBPV' random combination of Grade 1 and Grade 2 within a range+rangeBPV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeBPV (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (V3 a1 a2 a3, g'') = randV3 g'+ (BV a23 a31 a12, g''') = randBV g''+ x = sqrt $ (a1*a31 - a2*a23)^2 + (a1*a12 - a3*a23)^2 + (a2*a12 - a3*a31)^2+ invMag = recip.sqrt $ a1^2 + a23^2 + a2^2 + a31^2 + a3^2 + a12^2 + x + x+ mag = scale * invMag+ in (BPV (mag * a1) (mag * a2) (mag * a3) (mag * a23) (mag * a31) (mag * a12), g''')+++-- | 'randODD' random combination of Grade 1 and Grade 3+randODD :: RandomGen g => g -> (Cl3, g)+randODD = rangeODD (0,1)+++-- | 'rangeODD' random combination of Grade 1 and Grade 3 within a range+rangeODD :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeODD (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (V3 a1 a2 a3, g'') = randV3 g'+ (I a123, g''') = randI g''+ invMag = recip.sqrt $ a1^2 + a2^2 + a3^2 + a123^2+ mag = scale * invMag+ in (ODD (mag * a1) (mag * a2) (mag * a3) (mag * a123), g''')+++-- | 'randTPV' random combination of Grade 2 and Grade 3+randTPV :: RandomGen g => g -> (Cl3, g)+randTPV = rangeTPV (0,1)+++-- | 'rangeTPV' random combination of Grade 2 and Grade 3 within a range+rangeTPV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeTPV (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (BV a23 a31 a12, g'') = randBV g'+ (I a123, g''') = randI g''+ sumsqs = a23^2 + a31^2 + a12^2+ x = abs a123 * sqrt sumsqs+ invMag = recip.sqrt $ sumsqs + a123^2 + x + x+ mag = scale * invMag+ in (TPV (mag * a23) (mag * a31) (mag * a12) (mag * a123), g''')+++-- | 'randAPS' random combination of all 4 grades+randAPS :: RandomGen g => g -> (Cl3, g)+randAPS = rangeAPS (0,1)+++-- | 'rangeAPS' random combination of all 4 grades within a range+rangeAPS :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeAPS (lo, hi) g =+ let (R scale, g') = rangeR (lo, hi) g+ (C a0 a123, g'') = randC g'+ (V3 a1 a2 a3, g''') = randV3 g''+ (BV a23 a31 a12, g'v) = randBV g'''+ x = sqrt $ (a0*a1 + a123*a23)^2 + (a0*a2 + a123*a31)^2 + (a0*a3 + a123*a12)^2 + (a2*a12 - a3*a31)^2 + (a3*a23 - a1*a12)^2 + (a1*a31 - a2*a23)^2+ invMag = recip.sqrt $ a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 + x + x+ mag = scale * invMag+ in (APS (mag * a0) (mag * a1) (mag * a2) (mag * a3) (mag * a23) (mag * a31) (mag * a12) (mag * a123), g'v)+++-------------------------------------------------------------------+-- Additional Random generators+-------------------------------------------------------------------+-- | 'randUnitV3' a unit vector with a random direction+randUnitV3 :: RandomGen g => g -> (Cl3, g)+randUnitV3 g =+ let (theta, g') = randomR (0,2*pi) g+ (u, g'') = randomR (-1,1) g'+ simicircle = sqrt (1-u^2)+ in (V3 (simicircle * cos theta) (simicircle * sin theta) u, g'')+++-- | 'randProjector' a projector with a random direction+randProjector :: RandomGen g => g -> (Cl3, g)+randProjector g =+ let (V3 a1 a2 a3, g') = randUnitV3 g+ in (PV 0.5 (0.5 * a1) (0.5 * a2) (0.5 * a3), g')+++-- | 'rangeProjector' a projector with a range of random magnitudes and directions+rangeProjector :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeProjector (lo, hi) g =+ let (R mag, g') = rangeR (lo, hi) g+ (PV a0 a1 a2 a3, g'') = randProjector g'+ in (PV (mag * a0) (mag * a1) (mag * a2) (mag * a3), g'')+++-- | 'randNilpotent' a nilpotent element with a random orientation+randNilpotent :: RandomGen g => g -> (Cl3, g)+randNilpotent g =+ let (PV a0 a1 a2 a3, g') = randProjector g+ (V3 b1 b2 b3, g'') = randUnitV3 g'+ c1 = a2*b3 - a3*b2+ c2 = a3*b1 - a1*b3+ c3 = a1*b2 - a2*b1 -- (V3 c1 c2 c3) vector normal to the projector: mIx.toBV $ toV3 p * v+ invMag = recip.sqrt $ c1^2 + c2^2 + c3^2+ d1 = invMag * c1+ d2 = invMag * c2+ d3 = invMag * c3 -- (V3 d1 d2 d3) unit vector normal to the projector+ in (BPV (d1*a0) (d2*a0) (d3*a0) (d2*a3 - d3*a2) (d3*a1 - d1*a3) (d1*a2 - d2*a1), g'')+++-- | 'rangeNilpotent' a nilpotent with a range of random magnitudes and orientations+rangeNilpotent :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeNilpotent (lo, hi) g =+ let (R mag, g') = rangeR (lo, hi) g+ (BPV a1 a2 a3 a23 a31 a12, g'') = randNilpotent g'+ in (BPV (mag * a1) (mag * a2) (mag * a3) (mag * a23) (mag * a31) (mag * a12), g'')+++-- | 'randUnitary' a unitary element with a random orientation+randUnitary :: RandomGen g => g -> (Cl3, g)+randUnitary g =+ let (tpv,g') = randTPV g+ in (exp tpv,g')+++-- | 'rangeUnitary' a unitary element with a range of random magnitudes and orientations, the exponential of a triparavector+rangeUnitary :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)+rangeUnitary (lo, hi) g =+ let (tpv, g') = rangeTPV (lo, hi) g+ in (exp tpv, g')+++-------------------------------------------------------------------+-- helper functions+-------------------------------------------------------------------+magHelper :: RandomGen g => (Cl3, Cl3) -> g -> (Double, g)+magHelper (lo, hi) g =+ let R lo' = abs lo+ R hi' = abs hi+ in randomR (lo', hi') g+++scalarHelper :: RandomGen g => (Double -> Cl3) -> (Cl3, Cl3) -> g -> (Cl3, g)+scalarHelper con rng g =+ let (mag, g') = magHelper rng g+ (sign, g'') = random g'+ in if sign+ then (con mag, g'')+ else (con (negate mag), g'')+++vectorHelper :: RandomGen g => (Double -> Double -> Double -> Cl3) -> (Cl3, Cl3) -> g -> (Cl3, g)+vectorHelper con rng g =+ let (mag, g') = magHelper rng g+ (V3 x y z, g'') = randUnitV3 g'+ in (con (mag * x) (mag * y) (mag * z), g'')+++#endif++-- End of File
src/Algebra/Geometric/Cl3/JonesCalculus.hs view
@@ -1,7 +1,14 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ == 810+-- Work around to fix GHC Issue #15304, issue popped up again in GHC 8.10, it should be fixed in GHC 8.12+-- This code is meant to reproduce MR 2608 for GHC 8.10+{-# OPTIONS_GHC -funfolding-keeness-factor=1 -funfolding-use-threshold=80 #-}+#endif+ -------------------------------------------------------------------------------------------- -- | -- Copyright : (C) 2018 Nathan Waivio@@ -56,17 +63,22 @@ wpRot, -- * Reflection refl,+#ifndef O_NO_RANDOM -- * Random Jones Vectors randJonesVec, randOrthogonalJonesVec,+#endif -- * Normalization Factorization factorize ) where -import safe Algebra.Geometric.Cl3 (Cl3(..), dag, bar, toR, toV3, toC, project, randUnitV3)-import System.Random (RandomGen)+import safe Algebra.Geometric.Cl3 (Cl3(..), dag, bar, toR, toV3, toC, project) +#ifndef O_NO_RANDOM+import safe Algebra.Geometric.Cl3 (randUnitV3)+import System.Random (RandomGen)+#endif e0 = R 1 e1 = V3 1 0 0@@ -192,6 +204,7 @@ phi = 2 * (-i) * log normC in (amp, phi, normJonesVec) +#ifndef O_NO_RANDOM ------------------------------------------------------------------- -- -- Random Jones Vectors@@ -210,3 +223,5 @@ randOrthogonalJonesVec g = let (v3, g') = randUnitV3 g in ((jv v3, jv (bar v3)),g')++#endif
stack.yaml view
@@ -1,3 +1,3 @@ packages: - .-resolver: lts-12.6+resolver: nightly-2020-07-19
tests/TestCl3.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ == 810+-- Work around to fix GHC Issue #15304, issue popped up again in GHC 8.10, it should be fixed in GHC 8.12+-- This code is meant to reproduce MR 2608 for GHC 8.10+{-# OPTIONS_GHC -funfolding-keeness-factor=1 -funfolding-use-threshold=80 #-}+#endif ------------------------------------------------------------------- -- |--- Copyright : (c) 2017 Nathan Waivio+-- Copyright : (c) 2017-2020 Nathan Waivio -- License : BSD3 -- Maintainer : Nathan Waivio <nathan.waivio@gmail.com> -- @@ -16,10 +22,10 @@ module Main (main) where -import Test.QuickCheck (Arbitrary, arbitrary, oneof, suchThat, quickCheckWith, stdArgs, maxSuccess) import Algebra.Geometric.Cl3-import Control.Applicative ((<*>), (<$>))-+import Control.Monad (replicateM)+import Criterion.Main (defaultMain, bench, nfIO, env, Benchmark)+import System.Random (randomRIO) ------------------------------------------------------------------ -- |@@ -36,7 +42,6 @@ -- -- * Approximate equivalence is tested due to limitations with respect to floating point math. ----- * The implementation of Arbitrary for Cl3 limits the arbitrary cliffor such that the absolute value of cliff is less than 15 -- -- The following properties are verified in this module: --@@ -96,72 +101,61 @@ -- ------------------------------------------------------------------- + main :: IO ()-main = do moduleTests- print "Testing log.exp Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_LogExp- print "Testing exp.log Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_ExpLog- print "Testing abs*signum law:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AbsSignum- print "Testing the definition of recip:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_RecipDef- print "Testing recip.recip Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_RecipID- print "Testing sin.asin Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_SinAsin- print "Testing asin.sin Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AsinSin- print "Testing cos.acos Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_CosAcos- print "Testing acos.cos Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AcosCos- print "Testing sinh.asinh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_SinhAsinh- print "Testing asinh.sinh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AsinhSinh- print "Testing cosh.acosh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_CoshAcosh- print "Testing acosh.cosh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AcoshCosh- print "Testing acosh.cosh Identity2:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_AcoshCosh2- print "Testing Double Sin Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubSin- print "Testing Double Cos Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubCos- print "Testing Double Tan Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubTan- print "Testing Double Sinh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubSinh- print "Testing Double Cosh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubCosh- print "Testing Double Tanh Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DubTanh- print "Testing Positive Sin Shift Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_PosSinShift- print "Testing Negative Sin Shift Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_NegSinShift- print "Testing sin^2+cos^2 Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_SinSqCosSq- print "Testing cosh^2-sinh^2 Identity:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_CoshSqmSinhSq- print "Testing Symmetry of Cosh:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_SymCosh- print "Testing Symmetry of Sinh:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_SymSinh- print "Testing Double I Sin:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_DoubleISin- print "Is has Composition Sub-Algebras:"- quickCheckWith stdArgs { maxSuccess = 30000 } prop_CompAlg+main = defaultMain benchList +benchList :: [Benchmark]+benchList = fmap buildBench props +props :: [(String,(Cl3 -> Bool))]+props = [("Testing log.exp Identity:", prop_LogExp),+ ("Testing exp.log Identity:", prop_ExpLog),+ ("Testing abs*signum law:", prop_AbsSignum),+ ("Testing the definition of recip:", prop_RecipDef),+ ("Testing recip.recip Identity:", prop_RecipID),+ ("Testing sin.asin Identity:", prop_SinAsin),+ ("Testing asin.sin Identity:", prop_AsinSin),+ ("Testing cos.acos Identity:", prop_CosAcos),+ ("Testing acos.cos Identity:", prop_AcosCos),+ ("Testing sinh.asinh Identity:", prop_SinhAsinh),+ ("Testing asinh.sinh Identity:", prop_AsinhSinh),+ ("Testing cosh.acosh Identity:", prop_CoshAcosh),+ ("Testing acosh.cosh Identity:", prop_AcoshCosh),+ ("Testing acosh.cosh Identity2:", prop_AcoshCosh2),+ ("Testing Double Sin Identity:", prop_DubSin),+ ("Testing Double Cos Identity:", prop_DubCos),+ ("Testing Double Tan Identity:", prop_DubTan),+ ("Testing Double Sinh Identity:", prop_DubSinh),+ ("Testing Double Cosh Identity:", prop_DubCosh),+ ("Testing Double Tanh Identity:", prop_DubTanh),+ ("Testing Positive Sin Shift Identity:", prop_PosSinShift),+ ("Testing Negative Sin Shift Identity:", prop_NegSinShift),+ ("Testing sin^2+cos^2 Identity:", prop_SinSqCosSq),+ ("Testing cosh^2-sinh^2 Identity:", prop_CoshSqmSinhSq),+ ("Testing Symmetry of Cosh:", prop_SymCosh),+ ("Testing Symmetry of Sinh:", prop_SymSinh),+ ("Testing Double I Sin:", prop_DoubleISin)] -------------------------------------------------------------- |Start of Module Tests-moduleTests :: IO ()-moduleTests = sequence_ $ tests <*> inputs+buildBench :: (String,(Cl3 -> Bool)) -> Benchmark+buildBench (name, prop) = runWithEnv $ \cliffs -> bench name (nfIO $ test cliffs)+ where+ test :: [Cl3] -> IO ()+ test ([]) = return ()+ test (cl:cls) =+ if prop cl+ then test cls+ else error $ "Failed on input: " ++ show cl +runWithEnv :: ([Cl3] -> Benchmark) -> Benchmark+runWithEnv = (env listRandCliffs)++listRandCliffs :: IO [Cl3]+listRandCliffs = do+ randCliff <-(replicateM 5000000).randomRIO $ (R 0, R 3)+ return (inputs ++ randCliff)++-- Standard inputs and special cases of projectors and nilpotents inputs :: [Cl3] inputs = [R 0 ,APS 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8@@ -170,224 +164,217 @@ ,BPV 0.5 0 0 0 (-0.5) 0 ,BPV 0.5 0 0 0 0.5 0 ,R 1+ ,R (-1)+ ,R pi+ ,R (pi/2)+ ,R (pi/4) ,V3 1 0 0 ,APS 1 0.5 0 0 0 0.5 0 0 ,APS 1 0.5 0 0 0 (-0.5) 0 0 ,PV 1 1 0 0- ,R 1- ,R (-1) ,V3 1 0 0 ,V3 (-1) 0 0 ,V3 0 1 0 ,V3 0 (-1) 0 ,V3 0 0 1 ,V3 0 0 (-1)+ ,V3 pi 0 0+ ,V3 (pi/2) 0 0+ ,V3 (pi/4) 0 0 ,BV 1 0 0 ,BV (-1) 0 0 ,BV 0 1 0 ,BV 0 (-1) 0 ,BV 0 0 1 ,BV 0 0 (-1)+ ,BV pi 0 0+ ,BV (pi/2) 0 0+ ,BV (pi/4) 0 0 ,I 1 ,I (-1)+ ,I pi+ ,I (pi/2)+ ,I (pi/4) ] --- | 'tests' is a list of tests--- The out of bounds can be the poles of the function or if the cliffor has--- nilpotent content then the poles of the derivative as well as the function-tests :: [Cl3 -> IO()]-tests = [runTest "Log.Exp Identity" (log.exp) id (const False)- ,runTest "Exp.Log Identity" (exp.log) id (\z -> lsv z < tol) -- singular inputs are out of bounds- ,runTest "Abs*Signum Identity" (\x->abs x * signum x) id (const False)- ,runTest "Reciprical Identity" (recip.recip) id (\z -> lsv z < tol) -- singular inputs are out of bounds- ,runTest "sin.asin" (sin.asin) id (\z -> hasNilpotent z && poles [R 1, R (-1)] z)- ,runTest "asin.sin" (asin.sin) (\z -> negate (I 1) * log (0.5 * (exp (I 1 * z) - exp (I (-1) * z)) +- sqrt (1+0.25*(exp (I (-1) * z) - exp (I 1 * z))^2))) (const False)- ,runTest "cos.acos" (cos.acos) id (\z -> hasNilpotent z && poles [R 1, R (-1)] z)- ,runTest "acos.cos" (acos.cos) (\z -> 0.5 * (pi - 2 * asin(cos z))) (\z -> hasNilpotent z && poles [R 0, pi, negate pi] z)- ,runTest "sinh.asinh" (sinh.asinh) id (const False)- ,runTest "asinh.sinh" (asinh.sinh) (\z -> log (0.5*(exp z - exp (negate z)) + sqrt (0.25 * (exp z - exp (negate z))^2 + 1))) (const False)- ,runTest "cosh.acosh" (cosh.acosh) id (\z -> hasNilpotent z && poles [R 1, R (-1)] z)- ,runTest "acosh.cosh" (acosh.cosh) (\z -> log (0.5*(exp z + exp (negate z)) +- sqrt (0.5*(exp z + exp (negate z)) - 1) * sqrt (0.5*(exp z + exp (negate z)) + 1))) (const False)- ,runTest "Double Angle sin" (\z -> sin (2 * z)) (\z -> 2 * sin z * cos z) (const False)- ,runTest "Double Angle cos" (\z -> cos (2 * z)) (\z -> cos z ^ 2 - sin z ^ 2) (const False)- ,runTest "Double Angle tan" (\z -> tan (2 * z)) (\z -> (2 * tan z) / (1 - tan z ^ 2)) (const False)- ,runTest "+Sin Shift" (\z -> sin (pi/2 + z)) cos (const False)- ,runTest "-Sin Shift" (\z -> sin (pi/2 - z)) cos (const False)- ,runTest "Double Angle sinh" (\z -> sinh (2 * z)) (\z -> 2 * sinh z * cosh z) (const False)- ,runTest "Double Angle cosh" (\z -> cosh (2 * z)) (\z -> 2 * cosh z ^ 2 - 1) (const False)- ,runTest "Double Angle tanh" (\z -> tanh (2 * z)) (\z -> (2 * tanh z) / (1 + tanh z ^ 2)) (const False)- ,runTest "sin^2+cos^2" (\z -> sin z ^ 2 + cos z ^ 2) (const $ R 1) (const False)- ,runTest "cosh^2-sinh^2" (\z -> cosh z ^ 2 - sinh z ^ 2) (const $ R 1) (const False)- ,runTest "Symetry of cosh" (cosh.negate) cosh (const False)- ,runTest "Symetry of sinh" (sinh.negate) (negate.sinh) (const False)- ,runTest "sin.acos" (sin.acos) (\z -> sqrt (1 - z^2)) (\z -> hasNilpotent z && poles [R 1, R (-1)] z)- ,runTest "sin.atan" (sin.atan) (\z -> z / sqrt (1 + z^2)) (poles [I 1, I (-1)])- ,runTest "cos.atan" (cos.atan) (\z -> recip.sqrt $ 1 + z^2) (poles [I 1, I (-1)])- ,runTest "cos.asin" (cos.asin) (\z -> sqrt (1 - z^2)) (\z -> hasNilpotent z && poles [R 1, R (-1)] z)- ,runTest "tan.asin" (tan.asin) (\z -> z / sqrt (1 - z^2)) (poles [R 1, R (-1)])- ,runTest "tan.acos" (tan.acos) (\z -> sqrt (1 - z^2) / z) (\z -> if hasNilpotent z then poles [R 1, R 0, R (-1)] z else poles [R 0] z)- ] --- | The Properties-prop_LogExp :: ArbCl3 -> Bool-prop_LogExp (Arb cliffor) = (abs cliffor > 10) || (+-------------------------------------------------------+-- | A set of properties to test+-------------------------------------------------------++prop_LogExp :: Cl3 -> Bool+prop_LogExp (cliffor) = (abs cliffor > 10) || ( let cliffor' = unWrapIPartEigs cliffor -- imaginary part of log.exp repeats -- round off errors get large for exp larger than 5 use spectproj (log.exp) for accuracy- in log (exp cliffor') ≈≈ cliffor')+-- note: +/- i*pi are not really poles but cause issues due to cancelation for (BV pi 0 0)+ in poles [I (-pi), I (pi)] cliffor' || (log (exp cliffor') ≈≈ cliffor')) -- log 0 is -Inf, Infinite vectors don't play nice -- spectproj (exp.log) doesn't have this issue-prop_ExpLog :: ArbCl3 -> Bool-prop_ExpLog (Arb cliffor) = (lsv cliffor < tol) || (exp (log cliffor) ≈≈ cliffor)+prop_ExpLog :: Cl3 -> Bool+prop_ExpLog (cliffor) = (lsv cliffor < tol) || (exp (log cliffor) ≈≈ cliffor) -prop_AbsSignum :: ArbCl3 -> Bool-prop_AbsSignum (Arb cliffor) = abs cliffor * signum cliffor ≈≈ cliffor+prop_AbsSignum :: Cl3 -> Bool+prop_AbsSignum (cliffor) = abs cliffor * signum cliffor ≈≈ cliffor -prop_RecipDef :: ArbCl3 -> Bool-prop_RecipDef (Arb cliffor) = (lsv cliffor < tol) || (recip cliffor * cliffor ≈≈ 1)+prop_RecipDef :: Cl3 -> Bool+prop_RecipDef (cliffor) = (lsv cliffor < tol) || (recip cliffor * cliffor ≈≈ 1) -- singular inputs don't recip also suffers from roundoff errors at large values-prop_RecipID :: ArbCl3 -> Bool-prop_RecipID (Arb cliffor) = (lsv cliffor < tol) || (recip (recip cliffor) ≈≈ cliffor)+prop_RecipID :: Cl3 -> Bool+prop_RecipID (cliffor) = (lsv cliffor < tol) || (recip (recip cliffor) ≈≈ cliffor) -prop_SinAsin :: ArbCl3 -> Bool-prop_SinAsin (Arb cliffor) = if hasNilpotent cliffor- then poles [R 1, R (-1)] cliffor || (sin (asin cliffor) ≈≈ cliffor)- else sin (asin cliffor) ≈≈ cliffor+prop_SinAsin :: Cl3 -> Bool+prop_SinAsin (cliffor) = if hasNilpotent cliffor+ then poles [R 1, R (-1)] cliffor || (sin (asin cliffor) ≈≈ cliffor)+ else sin (asin cliffor) ≈≈ cliffor -prop_AsinSin :: ArbCl3 -> Bool-prop_AsinSin (Arb cliffor) = (abs cliffor > 10) || (asin (sin cliffor) ≈≈ (I (-1) * log (0.5 * (exp (I 1 * cliffor) - exp (I (-1) * cliffor)) +- sqrt (1+0.25*(exp (I (-1) * cliffor) - exp (I 1 * cliffor))^2))))+prop_AsinSin :: Cl3 -> Bool+prop_AsinSin (cliffor) = (abs cliffor > 10) || (asin (sin cliffor) ≈≈ (I (-1) * log (0.5 * (exp (I 1 * cliffor) - exp (mIx cliffor)) ++ sqrt (1+0.25*(exp (mIx cliffor) - exp (I 1 * cliffor))^2)))) -prop_CosAcos :: ArbCl3 -> Bool-prop_CosAcos (Arb cliffor) = if hasNilpotent cliffor+prop_CosAcos :: Cl3 -> Bool+prop_CosAcos (cliffor) = if hasNilpotent cliffor then poles [R 1, R (-1)] cliffor || (cos (acos cliffor) ≈≈ cliffor) else cos (acos cliffor) ≈≈ cliffor -prop_AcosCos :: ArbCl3 -> Bool-prop_AcosCos (Arb cliffor) = (abs cliffor > 10) || (if hasNilpotent cliffor- then poles [R 0, pi, negate pi] cliffor || (acos (cos cliffor) ≈≈ 0.5 * (pi - 2 * asin(cos cliffor)))- else acos (cos cliffor) ≈≈ 0.5 * (pi - 2 * asin(cos cliffor)))+prop_AcosCos :: Cl3 -> Bool+prop_AcosCos (cliffor) = (abs cliffor > 10) || (if hasNilpotent cliffor+ then poles [R 0, pi, negate pi] cliffor || (acos (cos cliffor) ≈≈ 0.5 * (pi - 2 * asin(cos cliffor)))+ else acos (cos cliffor) ≈≈ 0.5 * (pi - 2 * asin(cos cliffor))) -prop_SinhAsinh :: ArbCl3 -> Bool-prop_SinhAsinh (Arb cliffor) = sinh (asinh cliffor) ≈≈ cliffor+prop_SinhAsinh :: Cl3 -> Bool+prop_SinhAsinh (cliffor) = sinh (asinh cliffor) ≈≈ cliffor -prop_AsinhSinh :: ArbCl3 -> Bool-prop_AsinhSinh (Arb cliffor) = (abs cliffor > 10) || (asinh (sinh cliffor) ≈≈ log (0.5*(exp cliffor - exp (negate cliffor)) ++prop_AsinhSinh :: Cl3 -> Bool+prop_AsinhSinh (cliffor) = (abs cliffor > 10) || (asinh (sinh cliffor) ≈≈ log (0.5*(exp cliffor - exp (negate cliffor)) + sqrt (0.25 * (exp cliffor - exp (negate cliffor))^2 + 1))) -prop_CoshAcosh :: ArbCl3 -> Bool-prop_CoshAcosh (Arb cliffor) = if hasNilpotent cliffor- then poles [R 1, R (-1)] cliffor || (cosh (acosh cliffor) ≈≈ cliffor)- else cosh (acosh cliffor) ≈≈ cliffor+prop_CoshAcosh :: Cl3 -> Bool+prop_CoshAcosh (cliffor) = if hasNilpotent cliffor+ then poles [R 1, R (-1)] cliffor || (cosh (acosh cliffor) ≈≈ cliffor)+ else cosh (acosh cliffor) ≈≈ cliffor -prop_AcoshCosh :: ArbCl3 -> Bool-prop_AcoshCosh (Arb cliffor) = acosh (cosh cliffor) ≈≈ log (0.5*(exp cliffor + exp (negate cliffor)) +- sqrt (0.5*(exp cliffor + exp (negate cliffor)) - 1) *- sqrt (0.5*(exp cliffor + exp (negate cliffor)) + 1))+prop_AcoshCosh :: Cl3 -> Bool+prop_AcoshCosh (cliffor) = acosh (cosh cliffor) ≈≈ log (0.5*(exp cliffor + exp (negate cliffor)) ++ sqrt (0.5*(exp cliffor + exp (negate cliffor)) - 1) *+ sqrt (0.5*(exp cliffor + exp (negate cliffor)) + 1)) -prop_AcoshCosh2 :: ArbCl3 -> Bool-prop_AcoshCosh2 (Arb cliffor) = acosh (cosh cliffor) ≈≈ log (cosh cliffor + sqrt (cosh cliffor - 1) * sqrt (cosh cliffor + 1))+prop_AcoshCosh2 :: Cl3 -> Bool+prop_AcoshCosh2 (cliffor) = acosh (cosh cliffor) ≈≈ log (cosh cliffor + sqrt (cosh cliffor - 1) * sqrt (cosh cliffor + 1)) -prop_DubSin :: ArbCl3 -> Bool-prop_DubSin (Arb cliffor) = sin (2 * cliffor) ≈≈ 2 * sin cliffor * cos cliffor+prop_DubSin :: Cl3 -> Bool+prop_DubSin (cliffor) = sin (2 * cliffor) ≈≈ 2 * sin cliffor * cos cliffor -prop_DubCos :: ArbCl3 -> Bool-prop_DubCos (Arb cliffor) = cos (2 * cliffor) ≈≈ cos cliffor ^ 2 - sin cliffor ^ 2+prop_DubCos :: Cl3 -> Bool+prop_DubCos (cliffor) = cos (2 * cliffor) ≈≈ cos cliffor ^ 2 - sin cliffor ^ 2 -prop_DubTan :: ArbCl3 -> Bool-prop_DubTan (Arb cliffor) = tan (2 * cliffor) ≈≈ (2 * tan cliffor) / (1 - tan cliffor ^ 2)+prop_DubTan :: Cl3 -> Bool+prop_DubTan (cliffor) = poles [R (-pi), R (-3*pi/4), R (-pi/2), R (-pi/4), R (pi/4), R (pi/2), R (3*pi/4), R (pi)] cliffor ||+ (tan (2 * cliffor) ≈≈ (2 * tan cliffor) / (1 - tan cliffor ^ 2)) -prop_DubSinh :: ArbCl3 -> Bool-prop_DubSinh (Arb cliffor) = sinh (2 * cliffor) ≈≈ 2 * sinh cliffor * cosh cliffor+prop_DubSinh :: Cl3 -> Bool+prop_DubSinh (cliffor) = sinh (2 * cliffor) ≈≈ 2 * sinh cliffor * cosh cliffor -prop_DubCosh :: ArbCl3 -> Bool-prop_DubCosh (Arb cliffor) = cosh (2 * cliffor) ≈≈ 2 * cosh cliffor ^ 2 - 1+prop_DubCosh :: Cl3 -> Bool+prop_DubCosh (cliffor) = cosh (2 * cliffor) ≈≈ 2 * cosh cliffor ^ 2 - 1 -prop_DubTanh :: ArbCl3 -> Bool-prop_DubTanh (Arb cliffor) = tanh (2 * cliffor) ≈≈ (2 * tanh cliffor) / (1 + tanh cliffor ^ 2)+-- The test has poles at imaginary eigenvalues of n*pi/4 even is poles in the denominator and odd is poles in the numerator+-- The poles are a source of a loss of precision.+prop_DubTanh :: Cl3 -> Bool+prop_DubTanh (cliffor) = poles [I (-pi), I (-3*pi/4), I (-pi/2), I (-pi/4), I (pi/4), I (pi/2), I (3*pi/4), I (pi)] cliffor ||+ (tanh (2 * cliffor) ≈≈ (2 * tanh cliffor) / (1 + tanh cliffor ^ 2)) -prop_PosSinShift :: ArbCl3 -> Bool-prop_PosSinShift (Arb cliffor) = sin (pi/2 + cliffor) ≈≈ cos cliffor+prop_PosSinShift :: Cl3 -> Bool+prop_PosSinShift (cliffor) = sin (pi/2 + cliffor) ≈≈ cos cliffor -prop_NegSinShift :: ArbCl3 -> Bool-prop_NegSinShift (Arb cliffor) = sin (pi/2 - cliffor) ≈≈ cos cliffor+prop_NegSinShift :: Cl3 -> Bool+prop_NegSinShift (cliffor) = sin (pi/2 - cliffor) ≈≈ cos cliffor -prop_SinSqCosSq :: ArbCl3 -> Bool-prop_SinSqCosSq (Arb cliffor) = (abs cliffor > 10) || (sin cliffor ^ 2 + cos cliffor ^ 2 ≈≈ 1)+prop_SinSqCosSq :: Cl3 -> Bool+prop_SinSqCosSq (cliffor) = (abs cliffor > 10) || (sin cliffor ^ 2 + cos cliffor ^ 2 ≈≈ 1) -prop_CoshSqmSinhSq :: ArbCl3 -> Bool-prop_CoshSqmSinhSq (Arb cliffor) = (abs cliffor > 10) || (cosh cliffor ^ 2 - sinh cliffor ^ 2 ≈≈ 1)+prop_CoshSqmSinhSq :: Cl3 -> Bool+prop_CoshSqmSinhSq (cliffor) = (abs cliffor > 10) || (cosh cliffor ^ 2 - sinh cliffor ^ 2 ≈≈ 1) -prop_SymCosh :: ArbCl3 -> Bool-prop_SymCosh (Arb cliffor) = cosh (negate cliffor) ≈≈ cosh cliffor+prop_SymCosh :: Cl3 -> Bool+prop_SymCosh (cliffor) = cosh (negate cliffor) ≈≈ cosh cliffor -prop_SymSinh :: ArbCl3 -> Bool-prop_SymSinh (Arb cliffor) = sinh (negate cliffor) ≈≈ negate (sinh cliffor)+prop_SymSinh :: Cl3 -> Bool+prop_SymSinh (cliffor) = sinh (negate cliffor) ≈≈ negate (sinh cliffor) -prop_DoubleISin :: ArbCl3 -> Bool-prop_DoubleISin (Arb cliffor) = 2 * I 1 * sin cliffor ≈≈ exp(I 1 * cliffor) - exp (I (-1) * cliffor)+prop_DoubleISin :: Cl3 -> Bool+prop_DoubleISin (cliffor) = 2 * I 1 * sin cliffor ≈≈ exp(I 1 * cliffor) - exp (mIx cliffor) --- | Composition Sub-Algebras have a distributive norm over multiplication, like this:+-- | Composition Sub-Algebras have a distributive norm over multiplication,+-- like this: -- -- > norm $ clif * clif' = norm clif * norm clif' ----- Strangly the constructor combinations with the "= True" don't play nice with 'abs'--- they are the constructors with non-zero zero-divisors.-prop_CompAlg :: (ArbCl3, ArbCl3) -> Bool-prop_CompAlg (Arb PV{}, Arb PV{}) = True-prop_CompAlg (Arb PV{}, Arb BPV{}) = True-prop_CompAlg (Arb PV{}, Arb TPV{}) = True-prop_CompAlg (Arb PV{}, Arb APS{}) = True-prop_CompAlg (Arb BPV{}, Arb PV{}) = True-prop_CompAlg (Arb TPV{}, Arb PV{}) = True-prop_CompAlg (Arb APS{}, Arb PV{}) = True-prop_CompAlg (Arb BPV{}, Arb BPV{}) = True-prop_CompAlg (Arb BPV{}, Arb TPV{}) = True-prop_CompAlg (Arb BPV{}, Arb APS{}) = True-prop_CompAlg (Arb TPV{}, Arb BPV{}) = True-prop_CompAlg (Arb APS{}, Arb BPV{}) = True-prop_CompAlg (Arb TPV{}, Arb TPV{}) = True-prop_CompAlg (Arb TPV{}, Arb APS{}) = True-prop_CompAlg (Arb APS{}, Arb TPV{}) = True-prop_CompAlg (Arb APS{}, Arb APS{}) = True-prop_CompAlg (Arb cliffor, Arb cliffor') = abs ( cliffor * cliffor') ≈≈ abs cliffor * abs cliffor'-+-- Strangly the constructor combinations with the "= True" don't play nice+-- with 'abs' they are the constructors with non-zero zero-divisors.+prop_CompAlg :: (Cl3, Cl3) -> Bool+prop_CompAlg (PV{}, PV{}) = True+prop_CompAlg (PV{}, BPV{}) = True+prop_CompAlg (PV{}, TPV{}) = True+prop_CompAlg (PV{}, APS{}) = True+prop_CompAlg (BPV{}, PV{}) = True+prop_CompAlg (TPV{}, PV{}) = True+prop_CompAlg (APS{}, PV{}) = True+prop_CompAlg (BPV{}, BPV{}) = True+prop_CompAlg (BPV{}, TPV{}) = True+prop_CompAlg (BPV{}, APS{}) = True+prop_CompAlg (TPV{}, BPV{}) = True+prop_CompAlg (APS{}, BPV{}) = True+prop_CompAlg (TPV{}, TPV{}) = True+prop_CompAlg (TPV{}, APS{}) = True+prop_CompAlg (APS{}, TPV{}) = True+prop_CompAlg (APS{}, APS{}) = True+prop_CompAlg (cliffor, cliffor') = abs ( cliffor * cliffor') ≈≈ abs cliffor * abs cliffor' --- Run the test--- compare the function under test (fUT) to a golden test funcion (gTF)--- if the input is within bounds-runTest :: String -> (Cl3 -> Cl3) -> (Cl3 -> Cl3) -> (Cl3 -> Bool) -> Cl3 -> IO()-runTest testName fUT gTF outOB iVal =- let f = fUT iVal- g = gTF iVal- in if outOB iVal- then putStr (unlines [testName ++ ": Input Out of Bounds"])- else if f ≈≈ g- then putStr (unlines [testName ++ ": Passed"])- else putStr (unlines [testName ++ ": Failed"- ,"Expected: " ++ show g- ," got: " ++ show f- ,"on input: " ++ show iVal- ])+----------------------------------------------------+-- Helper functions for the properties+---------------------------------------------------- --- | '≈≈' aproximately equal+-- | '≈≈' aproximately equal, using a mean squared error like calculation+-- across the 8 dimensional vector space of APS. The properties are +-- equivelent symbolicly but differ due to numerical errors. (≈≈) :: Cl3 -> Cl3 -> Bool-(reduce -> clifforA) ≈≈ (reduce -> clifforB) =- let ave = (abs clifforA + abs clifforB) / 2- in abs (clifforA - clifforB) <= 1e-5*ave + tol+(toAPS -> (APS a0 a1 a2 a3 a23 a31 a12 a123)) ≈≈ (toAPS -> (APS b0 b1 b2 b3 b23 b31 b12 b123)) =+ let m0 = (a0 - b0)^2+ m1 = (a1 - b1)^2+ m2 = (a2 - b2)^2+ m3 = (a3 - b3)^2+ m23 = (a23 - b23)^2+ m31 = (a31 - b31)^2+ m12 = (a12 - b12)^2+ m123 = (a123 - b123)^2+ sumsq = m0 + m1 + m2 + m3 + m23 + m31 + m12 + m123+ var = sumsq / 8+ in var <= 2e-13+_ ≈≈ _ = error "Everything passed to (≈≈) should be caught by toAPS/APS pattern match" infix 4 ≈≈ -- | 'poles' a function that tests if a cliffor is one of the defined poles poles :: [Cl3] -> Cl3 -> Bool poles [] _ = False-poles [p] cliffor = eig1 ≈≈ p || eig2 ≈≈ p+poles [p] cliffor = eig1 `closeTo` p || eig2 `closeTo` p where (eig1,eig2) = eigvals cliffor-poles (p:ps) cliffor = (eig1 ≈≈ p || eig2 ≈≈ p) || poles ps cliffor+poles (p:ps) cliffor = (eig1 `closeTo` p || eig2 `closeTo` p) || poles ps cliffor where (eig1,eig2) = eigvals cliffor +-- | 'closeTo' used with poles to determine if an eigenvalue is close to a pole+-- the current threshold is 1e-3+closeTo :: Cl3 -> Cl3 -> Bool+closeTo (toC -> (C a0 a123)) (toC -> (C b0 b123)) =+ let diffR = abs (a0 - b0)+ diffI = abs (a123 - b123)+ magDiff = sqrt (diffR^2 + diffI^2)+ in magDiff < 2e-3+closeTo _ _ = error "Everything passed to 'closeTo' should be caught by toC/C pattern match"++-- | 'unWrapIPartEigs' a function to reduce the magnitude of the imaginary+-- portion of the Eigenvalues unWrapIPartEigs :: Cl3 -> Cl3 unWrapIPartEigs cliffor = reduce $ spectraldcmp unWrapI id cliffor where unWrapI (R a0) = R a0@@ -399,34 +386,4 @@ | otherwise = C a0 a123 unWrapI _ = error "unWrapI should only be unWrapping R I and C" ----------------------------------------------------------------------------------------------------------------------------------- --- Arbitrary Instance of Cl3 types, typically for use with the --- "Test.QuickCheck" library. --- ------------------------------------------------------------------------ | 'ArbCl3' to provide a newtype wrapper to avoid the orphan instance-newtype ArbCl3 = Arb Cl3 deriving (Show)---- | 'Arbitrary' instance that has its largest singular value less than or equal to 15-instance Arbitrary ArbCl3 where- arbitrary = - oneof [(Arb.)R <$> arbitrary, - ((Arb.).).V3 <$> arbitrary <*> arbitrary <*> arbitrary,- ((Arb.).).BV <$> arbitrary <*> arbitrary <*> arbitrary,- (Arb.)I <$> arbitrary,- (((Arb.).).).PV <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary,- (((Arb.).).).H <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary,- (Arb.).C <$> arbitrary <*> arbitrary,- (((((Arb.).).).).).BPV <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary,- (((Arb.).).).ODD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary,- (((Arb.).).).TPV <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary,- (((((((Arb.).).).).).).).APS <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- ] `suchThat` lessThan15- where- lessThan15 (Arb cliffor) = abs cliffor <= 15+-- End of File