-- Copyright (c) 2011-2015, David Amos. All rights reserved.

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, NoMonomorphismRestriction #-}

-- |A module defining the (non-associative) algebra of octonions over an arbitrary field.
--
-- The octonions are the algebra defined by the basis {1,i0,i1,i2,i3,i4,i5,i6},
-- where each i_n * i_n = -1, and i_n+1 * i_n+2 = i_n+4 (where the indices are modulo 7).
module Math.Algebras.Octonions where

import Prelude hiding ( (*>) )

import Math.Core.Field
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct hiding (i1,i2)
import Math.Algebras.Structures
import Math.Algebras.Quaternions

import Math.Combinatorics.FiniteGeometry (ptsAG)


-- Conway & Smith, On Quaternions and Octonions

-- OCTONIONS

data OBasis = O Int deriving (OBasis -> OBasis -> Bool
(OBasis -> OBasis -> Bool)
-> (OBasis -> OBasis -> Bool) -> Eq OBasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OBasis -> OBasis -> Bool
$c/= :: OBasis -> OBasis -> Bool
== :: OBasis -> OBasis -> Bool
$c== :: OBasis -> OBasis -> Bool
Eq,Eq OBasis
Eq OBasis =>
(OBasis -> OBasis -> Ordering)
-> (OBasis -> OBasis -> Bool)
-> (OBasis -> OBasis -> Bool)
-> (OBasis -> OBasis -> Bool)
-> (OBasis -> OBasis -> Bool)
-> (OBasis -> OBasis -> OBasis)
-> (OBasis -> OBasis -> OBasis)
-> Ord OBasis
OBasis -> OBasis -> Bool
OBasis -> OBasis -> Ordering
OBasis -> OBasis -> OBasis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OBasis -> OBasis -> OBasis
$cmin :: OBasis -> OBasis -> OBasis
max :: OBasis -> OBasis -> OBasis
$cmax :: OBasis -> OBasis -> OBasis
>= :: OBasis -> OBasis -> Bool
$c>= :: OBasis -> OBasis -> Bool
> :: OBasis -> OBasis -> Bool
$c> :: OBasis -> OBasis -> Bool
<= :: OBasis -> OBasis -> Bool
$c<= :: OBasis -> OBasis -> Bool
< :: OBasis -> OBasis -> Bool
$c< :: OBasis -> OBasis -> Bool
compare :: OBasis -> OBasis -> Ordering
$ccompare :: OBasis -> OBasis -> Ordering
$cp1Ord :: Eq OBasis
Ord)
-- map (return . O) [-1..6] -> [1,i0,i1,i2,i3,i4,i5,i6]

type Octonion k = Vect k OBasis

instance Show OBasis where
    show :: OBasis -> String
show (O n :: Int
n) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1 = "1"
               | 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 6 = "i" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
               | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error "Octonion: invalid basis element"

i0, i1, i2, i3, i4, i5, i6 :: Octonion Q
i0 :: Octonion Q
i0 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 0)
i1 :: Octonion Q
i1 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 1)
i2 :: Octonion Q
i2 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 2)
i3 :: Octonion Q
i3 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 3)
i4 :: Octonion Q
i4 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 4)
i5 :: Octonion Q
i5 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 5)
i6 :: Octonion Q
i6 = OBasis -> Octonion Q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O 6)

i_ :: Num k => Int -> Octonion k
i_ :: Int -> Octonion k
i_ n :: Int
n = OBasis -> Octonion k
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O Int
n)

instance (Eq k, Num k) => Algebra k OBasis where
    unit :: k -> Vect k OBasis
unit x :: k
x = k
x k -> Vect k OBasis -> Vect k OBasis
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> OBasis -> Vect k OBasis
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O (-1))
    mult :: Vect k (Tensor OBasis OBasis) -> Vect k OBasis
mult = (Tensor OBasis OBasis -> Vect k OBasis)
-> Vect k (Tensor OBasis OBasis) -> Vect k OBasis
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor OBasis OBasis -> Vect k OBasis
forall k. (Num k, Eq k) => Tensor OBasis OBasis -> Vect k OBasis
m where
        m :: Tensor OBasis OBasis -> Vect k OBasis
m (O (-1), O n :: Int
n) = OBasis -> Vect k OBasis
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O Int
n)
        m (O n :: Int
n, O (-1)) = OBasis -> Vect k OBasis
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O Int
n)
        m (O a :: Int
a, O b :: Int
b) = case (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7 of
                       0 -> -1
                       1 -> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7)       -- i_n+1 * i_n+2 == i_n+4
                       2 -> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+6) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7)       -- i_n+2 * i_n+4 == i_n+1
                       3 -> -1 k -> Vect k OBasis -> Vect k OBasis
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7) -- i_n+1 * i_n+4 == -i_n+2
                       4 -> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+5) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7)       -- i_n+4 * i_n+1 == i_n+2
                       5 -> -1 k -> Vect k OBasis -> Vect k OBasis
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+4) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7) -- i_n+4 * i_n+2 == -i_n+1
                       6 -> -1 k -> Vect k OBasis -> Vect k OBasis
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Int -> Vect k OBasis
forall k. Num k => Int -> Octonion k
i_ ((Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 7) -- i_n+2 * i_n+1 == -i_n+4

instance (Eq k, Num k) => HasConjugation k OBasis where
    conj :: Vect k OBasis -> Vect k OBasis
conj = (Vect k OBasis -> (OBasis -> Vect k OBasis) -> Vect k OBasis
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OBasis -> Vect k OBasis
forall k. (Eq k, Num k) => OBasis -> Vect k OBasis
conj') where
        conj' :: OBasis -> Vect k OBasis
conj' (O n :: Int
n) = (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1 then 1 else -1) k -> Vect k OBasis -> Vect k OBasis
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> OBasis -> Vect k OBasis
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> OBasis
O Int
n)
    -- ie conj = linear conj', but avoiding unnecessary nf call
    sqnorm :: Vect k OBasis -> k
sqnorm x :: Vect k OBasis
x = [k] -> k
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([k] -> k) -> [k] -> k
forall a b. (a -> b) -> a -> b
$ ((OBasis, k) -> k) -> [(OBasis, k)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map ((k -> Integer -> k
forall a b. (Num a, Integral b) => a -> b -> a
^2) (k -> k) -> ((OBasis, k) -> k) -> (OBasis, k) -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OBasis, k) -> k
forall a b. (a, b) -> b
snd) ([(OBasis, k)] -> [k]) -> [(OBasis, k)] -> [k]
forall a b. (a -> b) -> a -> b
$ Vect k OBasis -> [(OBasis, k)]
forall k b. Vect k b -> [(b, k)]
terms Vect k OBasis
x
    -- sqnorm x = scalarPart (x * conj x)
            
-- Hence, the octonions inherit a Fractional instance

-- octonions fq = [sum $ zipWith (\x n -> x *> i_ n) xs [-1..6] | xs <- ptsAG 8 fq]