{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

Abstraction of bases of finite dimensional modules
-}

module Algebra.ModuleBasis where

import qualified Number.Ratio as Ratio

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Module   as Module
import Algebra.Ring     (one, fromInteger)
import Algebra.Additive ((+), zero)

import Data.List (map, length, (++))

import Prelude(Eq, (==), Bool, Int, Integer, Float, Double, asTypeOf, )

{- |
It must hold:

>   Module.linearComb (flatten v `asTypeOf` [a]) (basis a) == v
>   dimension a v == length (flatten v `asTypeOf` [a])
-}
class (Module.C a v) => C a v where
    {- | basis of the module with respect to the scalar type,
         the result must be independent of argument, 'Prelude.undefined' should suffice. -}
    basis :: a -> [v]
    -- | scale a vector by a scalar
    flatten :: v -> [a]
    {- | the size of the basis, should also work for undefined argument,
         the result must be independent of argument, 'Prelude.undefined' should suffice. -}
    dimension :: a -> v -> Int

{-* Instances for atomic types -}

instance C Float Float where
   basis :: Float -> [Float]
basis Float
_ = [Float
forall a. C a => a
one]
   flatten :: Float -> [Float]
flatten = (Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[])
   dimension :: Float -> Float -> Int
dimension Float
_ Float
_ = Int
1

instance C Double Double where
   basis :: Double -> [Double]
basis Double
_ = [Double
forall a. C a => a
one]
   flatten :: Double -> [Double]
flatten = (Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:[])
   dimension :: Double -> Double -> Int
dimension Double
_ Double
_ = Int
1

instance C Int Int where
   basis :: Int -> [Int]
basis Int
_ = [Int
forall a. C a => a
one]
   flatten :: Int -> [Int]
flatten = (Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[])
   dimension :: Int -> Int -> Int
dimension Int
_ Int
_ = Int
1

instance C Integer Integer where
   basis :: Integer -> [Integer]
basis Integer
_ = [Integer
forall a. C a => a
one]
   flatten :: Integer -> [Integer]
flatten = (Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[])
   dimension :: Integer -> Integer -> Int
dimension Integer
_ Integer
_ = Int
1

instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where
   basis :: T a -> [T a]
basis T a
_ = [T a
forall a. C a => a
one]
   flatten :: T a -> [T a]
flatten = (T a -> [T a] -> [T a]
forall a. a -> [a] -> [a]
:[])
   dimension :: T a -> T a -> Int
dimension T a
_ T a
_ = Int
1



{-* Instances for composed types -}

instance (C a v0, C a v1) => C a (v0, v1) where
   basis :: a -> [(v0, v1)]
basis a
s = (v0 -> (v0, v1)) -> [v0] -> [(v0, v1)]
forall a b. (a -> b) -> [a] -> [b]
map (\v0
v -> (v0
v,v1
forall a. C a => a
zero)) (a -> [v0]
forall a v. C a v => a -> [v]
basis a
s) [(v0, v1)] -> [(v0, v1)] -> [(v0, v1)]
forall a. [a] -> [a] -> [a]
++
             (v1 -> (v0, v1)) -> [v1] -> [(v0, v1)]
forall a b. (a -> b) -> [a] -> [b]
map (\v1
v -> (v0
forall a. C a => a
zero,v1
v)) (a -> [v1]
forall a v. C a v => a -> [v]
basis a
s)
   flatten :: (v0, v1) -> [a]
flatten (v0
x0,v1
x1) = v0 -> [a]
forall a v. C a v => v -> [a]
flatten v0
x0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ v1 -> [a]
forall a v. C a v => v -> [a]
flatten v1
x1
   dimension :: a -> (v0, v1) -> Int
dimension a
s ~(v0
x0,v1
x1) = a -> v0 -> Int
forall a v. C a v => a -> v -> Int
dimension a
s v0
x0 Int -> Int -> Int
forall a. C a => a -> a -> a
+ a -> v1 -> Int
forall a v. C a v => a -> v -> Int
dimension a
s v1
x1

instance (C a v0, C a v1, C a v2) => C a (v0, v1, v2) where
   basis :: a -> [(v0, v1, v2)]
basis a
s = (v0 -> (v0, v1, v2)) -> [v0] -> [(v0, v1, v2)]
forall a b. (a -> b) -> [a] -> [b]
map (\v0
v -> (v0
v,v1
forall a. C a => a
zero,v2
forall a. C a => a
zero)) (a -> [v0]
forall a v. C a v => a -> [v]
basis a
s) [(v0, v1, v2)] -> [(v0, v1, v2)] -> [(v0, v1, v2)]
forall a. [a] -> [a] -> [a]
++
             (v1 -> (v0, v1, v2)) -> [v1] -> [(v0, v1, v2)]
forall a b. (a -> b) -> [a] -> [b]
map (\v1
v -> (v0
forall a. C a => a
zero,v1
v,v2
forall a. C a => a
zero)) (a -> [v1]
forall a v. C a v => a -> [v]
basis a
s) [(v0, v1, v2)] -> [(v0, v1, v2)] -> [(v0, v1, v2)]
forall a. [a] -> [a] -> [a]
++
             (v2 -> (v0, v1, v2)) -> [v2] -> [(v0, v1, v2)]
forall a b. (a -> b) -> [a] -> [b]
map (\v2
v -> (v0
forall a. C a => a
zero,v1
forall a. C a => a
zero,v2
v)) (a -> [v2]
forall a v. C a v => a -> [v]
basis a
s)
   flatten :: (v0, v1, v2) -> [a]
flatten (v0
x0,v1
x1,v2
x2) = v0 -> [a]
forall a v. C a v => v -> [a]
flatten v0
x0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ v1 -> [a]
forall a v. C a v => v -> [a]
flatten v1
x1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ v2 -> [a]
forall a v. C a v => v -> [a]
flatten v2
x2
   dimension :: a -> (v0, v1, v2) -> Int
dimension a
s ~(v0
x0,v1
x1,v2
x2) = a -> v0 -> Int
forall a v. C a v => a -> v -> Int
dimension a
s v0
x0 Int -> Int -> Int
forall a. C a => a -> a -> a
+ a -> v1 -> Int
forall a v. C a v => a -> v -> Int
dimension a
s v1
x1 Int -> Int -> Int
forall a. C a => a -> a -> a
+ a -> v2 -> Int
forall a v. C a v => a -> v -> Int
dimension a
s v2
x2



{- * Properties -}

propFlatten :: (Eq v, C a v) => a -> v -> Bool
propFlatten :: a -> v -> Bool
propFlatten a
a v
v  =  [a] -> [v] -> v
forall a v. C a v => [a] -> [v] -> v
Module.linearComb (v -> [a]
forall a v. C a v => v -> [a]
flatten v
v [a] -> [a] -> [a]
forall a. a -> a -> a
`asTypeOf` [a
a]) (a -> [v]
forall a v. C a v => a -> [v]
basis a
a) v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v

propDimension :: (C a v) => a -> v -> Bool
propDimension :: a -> v -> Bool
propDimension a
a v
v  =  a -> v -> Int
forall a v. C a v => a -> v -> Int
dimension a
a v
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (v -> [a]
forall a v. C a v => v -> [a]
flatten v
v [a] -> [a] -> [a]
forall a. a -> a -> a
`asTypeOf` [a
a])