{-# LANGUAGE Safe #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
#if __GLASGOW_HASKELL__ == 810
{-# OPTIONS_GHC -funfolding-keeness-factor=1 -funfolding-use-threshold=80 #-}
#endif
module Algebra.Geometric.Cl3
(
Cl3(..),
bar, dag,
lsv,
toR, toV3, toBV, toI,
toPV, toH, toC,
toBPV, toODD, toTPV,
toAPS,
showOctave,
reduce, tol,
#ifndef O_NO_RANDOM
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
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
data Cl3 where
R :: !Double -> Cl3
V3 :: !Double -> !Double -> !Double -> Cl3
BV :: !Double -> !Double -> !Double -> Cl3
I :: !Double -> Cl3
PV :: !Double -> !Double -> !Double -> !Double -> Cl3
H :: !Double -> !Double -> !Double -> !Double -> Cl3
C :: !Double -> !Double -> Cl3
BPV :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3
ODD :: !Double -> !Double -> !Double -> !Double -> Cl3
TPV :: !Double -> !Double -> !Double -> !Double -> Cl3
APS :: !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> !Double -> Cl3
#ifndef O_NO_DERIVED
deriving (Show, Read, Typeable, Data, Generic)
#else
instance Show Cl3 where
show = showOctave
#endif
instance NFData Cl3 where
rnf !_ = ()
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"
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
instance Ord Cl3 where
compare (R a0) (R b0) = compare a0 b0
compare (I a123) (I b123) = compare a123 b123
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'
instance Num Cl3 where
(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)
(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 (R a0) = R (abs a0)
abs (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2))
abs (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2))
abs (I a123) = R (abs a123)
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))
abs (C a0 a123) = R (sqrt (a0^2 + a123^2))
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)
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)
in R (sqrt (a0^2 + a1^2 + a2^2 + a3^2 + a23^2 + a31^2 + a12^2 + a123^2 + x + x))
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 int = R (fromInteger int)
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 :: 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)
instance Fractional Cl3 where
recip (R a0) = R (recip a0)
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)
go_recip (C a0 a123) = C (recipsqmag * a0) (negrecipsqmag * a123)
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 rat = R (fromRational rat)
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)
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)
| a0 > 1 = C (pi/2) (negate.log $ (a0 + sqrt (a0^2 - 1)))
| a0 >= (-1) = R (asin a0)
| otherwise = C (-pi/2) (negate.log.abs $ (a0 + sqrt (a0^2 - 1)))
asin (I a123)
| a123 == 0 = R 0
| otherwise = I (asinh a123)
asin (C a0 a123) =
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)
| a0 > 1 = I (log (a0 + sqrt (a0^2 - 1)))
| a0 >= (-1) = R (acos a0)
| otherwise = C pi (log.abs $ (a0 + sqrt (a0^2 - 1)))
acos (I a123)
| a123 == 0 = R (pi/2)
| otherwise = C (pi/2) (negate $ asinh a123)
acos (C a0 a123) =
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)
| a123 > 1 = C (pi/2) (0.5*(log (1 + a123) - log (a123 - 1)))
| a123 == 0 = R 0
| a123 >= (-1) = I (atanh a123)
| otherwise = C (-pi/2) (((log.negate $ (1 + a123)) - log (1 - a123))/2)
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)
| a123 > 1 = C (log.abs $ (a123 + sqrt (a123^2 - 1))) (pi/2)
| a123 == 0 = R 0
| a123 >= (-1) = I (asin a123)
| otherwise = C (log.abs $ (a123 + sqrt (a123^2 - 1))) (-pi/2)
asinh (C a0 a123) =
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)
| a0 >= 1 = R (acosh a0)
| a0 >= (-1) = I (atan2 (sqrt $ 1-a0^2) a0)
| otherwise = C (acosh.negate $ a0) pi
acosh (I a123)
| a123 > 0 = C (log.abs $ (a123 + sqrt (1 + a123^2))) (pi/2)
| a123 == 0 = I (pi/2)
| otherwise = C (log.abs $ (a123 - sqrt (1 + a123^2))) (-pi/2)
acosh (C a0 a123) =
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)
| a0 > 1 = C ((log (1+a0) - log (a0-1))/2) (-pi/2)
| a0 >= (-1) = R (atanh a0)
| otherwise = C (((log.negate $ 1+a0) - log (1-a0))/2) (pi/2)
atanh (I a123)
| a123 == 0 = R 0
| otherwise = I (atan a123)
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 :: Cl3 -> Cl3
lsv (R a0) = R (abs a0)
lsv (V3 a1 a2 a3) = R (sqrt (a1^2 + a2^2 + a3^2))
lsv (BV a23 a31 a12) = R (sqrt (a23^2 + a31^2 + a12^2))
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))
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
y = a1^2 + a23^2 + a2^2 + x + a31^2 + a3^2 + a12^2 + x
in if y <= tol'
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
y = a0^2 + a1^2 + a2^2 + a3^2 + x + a23^2 + a31^2 + a12^2 + a123^2 + x
in if y <= tol'
then R 0
else R (sqrt y)
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'
then 0
else sqrt y
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
dcmp pv@PV{} = spectraldcmpSpecial toR fun pv
dcmp bv@BV{} = spectraldcmpSpecial toI fun bv
dcmp tpv@TPV{} = spectraldcmpSpecial toI fun tpv
dcmp h@H{} = spectraldcmpSpecial toC fun h
dcmp od@ODD{} = spectraldcmpSpecial toC fun od
dcmp cliff
| hasNilpotent cliff = jordan toC fun fun' cliff
| isColinear cliff = spectraldcmpSpecial toC fun cliff
| otherwise =
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
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 :: (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 :: 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
eigv pv@PV{} = eigvalsSpecial toR pv
eigv bv@BV{} = eigvalsSpecial toI bv
eigv tpv@TPV{} = eigvalsSpecial toI tpv
eigv h@H{} = eigvalsSpecial toC h
eigv od@ODD{} = eigvalsSpecial toC od
eigv cliff
| hasNilpotent cliff = dup.reduce.toC $ cliff
| isColinear cliff = eigvalsSpecial toC cliff
| otherwise =
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)
dup :: Cl3 -> (Cl3,Cl3)
dup cliff = (cliff, cliff)
eigvalsSpecial :: (Cl3 -> Cl3) -> Cl3 -> (Cl3,Cl3)
eigvalsSpecial toSpecial cliffor =
let (_,_,eig1,eig2) = projEigs toSpecial cliffor
in (eig1,eig2)
project :: Cl3 -> Cl3
project R{} = PV 0.5 0 0 0.5
project I{} = PV 0.5 0 0 0.5
project C{} = PV 0.5 0 0 0.5
project (V3 a1 a2 a3) = triDProj a1 a2 a3
project (PV _ a1 a2 a3) = triDProj a1 a2 a3
project (ODD a1 a2 a3 _) = triDProj a1 a2 a3
project (BV a23 a31 a12) = triDProj a23 a31 a12
project (H _ a23 a31 a12) = triDProj a23 a31 a12
project (TPV a23 a31 a12 _) = triDProj a23 a31 a12
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
biTriDProj :: Double -> Double -> Double -> Double -> Double -> Double -> 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 :: Double -> Double -> Double -> 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 :: Double -> Double -> Double -> Double -> Double -> Double -> 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 :: 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 ||
magBV == 0 ||
crss <= tol'
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 &&
magBV /= 0 &&
magDiff <= tol' &&
sqMag <= tol'
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 :: 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 :: 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 :: 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 :: Cl3
{-# INLINE tol #-}
tol = R 1.4210854715202004e-14
tol' :: Double
{-# INLINE tol' #-}
tol' = 1.4210854715202004e-14
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 :: 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)
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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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
recip' :: Cl3 -> Cl3
recip' = negate.recip.(^2)
exp' :: Cl3 -> Cl3
exp' = exp
log' :: Cl3 -> Cl3
log' = recip
sqrt' :: Cl3 -> Cl3
sqrt' = (/2).recip.sqrt
sin' :: Cl3 -> Cl3
sin' = cos
cos' :: Cl3 -> Cl3
cos' = negate.sin
tan' :: Cl3 -> Cl3
tan' = recip.(^2).cos
asin' :: Cl3 -> Cl3
asin' = recip.sqrt.(1-).(^2)
acos' :: Cl3 -> Cl3
acos' = negate.recip.sqrt.(1-).(^2)
atan' :: Cl3 -> Cl3
atan' = recip.(1+).(^2)
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)
acosh' :: Cl3 -> Cl3
acosh' x = recip $ sqrt (x - 1) * sqrt (x + 1)
atanh' :: Cl3 -> Cl3
atanh' = recip.(1-).(^2)
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
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)
data ConCl3 = ConR
| ConV3
| ConBV
| ConI
| ConPV
| ConH
| ConC
| ConBPV
| ConODD
| ConTPV
| ConAPS
| ConProj
| ConNilpotent
| ConUnitary
deriving (Bounded, Enum)
randR :: RandomGen g => g -> (Cl3, g)
randR = rangeR (0,1)
rangeR :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)
rangeR = scalarHelper R
randV3 :: RandomGen g => g -> (Cl3, g)
randV3 = rangeV3 (0,1)
rangeV3 :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)
rangeV3 = vectorHelper V3
randBV :: RandomGen g => g -> (Cl3, g)
randBV = rangeBV (0,1)
rangeBV :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)
rangeBV = vectorHelper BV
randI :: RandomGen g => g -> (Cl3, g)
randI = rangeI (0,1)
rangeI :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)
rangeI = scalarHelper I
randPV :: RandomGen g => g -> (Cl3, g)
randPV = rangePV (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randH = rangeH (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randC = rangeC (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randBPV = rangeBPV (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randODD = rangeODD (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randTPV = rangeTPV (0,1)
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 :: RandomGen g => g -> (Cl3, g)
randAPS = rangeAPS (0,1)
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)
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 :: 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 :: 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 :: 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
invMag = recip.sqrt $ c1^2 + c2^2 + c3^2
d1 = invMag * c1
d2 = invMag * c2
d3 = invMag * c3
in (BPV (d1*a0) (d2*a0) (d3*a0) (d2*a3 - d3*a2) (d3*a1 - d1*a3) (d1*a2 - d2*a1), g'')
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 :: RandomGen g => g -> (Cl3, g)
randUnitary g =
let (tpv,g') = randTPV g
in (exp tpv,g')
rangeUnitary :: RandomGen g => (Cl3, Cl3) -> g -> (Cl3, g)
rangeUnitary (lo, hi) g =
let (tpv, g') = rangeTPV (lo, hi) g
in (exp tpv, g')
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