summaryrefslogtreecommitdiff
path: root/packages/base/src/Numeric/LinearAlgebra/Util/Static.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Numeric/LinearAlgebra/Util/Static.hs')
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Util/Static.hs70
1 files changed, 70 insertions, 0 deletions
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Util/Static.hs
new file mode 100644
index 0000000..a3f8eb0
--- /dev/null
+++ b/packages/base/src/Numeric/LinearAlgebra/Util/Static.hs
@@ -0,0 +1,70 @@
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE KindSignatures #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE EmptyDataDecls #-}
8{-# LANGUAGE Rank2Types #-}
9{-# LANGUAGE FlexibleInstances #-}
10{-# LANGUAGE TypeOperators #-}
11
12module Numeric.LinearAlgebra.Util.Static(
13 Static (ddata),
14 R,
15 vect0, sScalar, vect2, vect3, (&)
16) where
17
18
19import GHC.TypeLits
20import Data.Packed.Numeric
21import Numeric.Vector()
22import Numeric.LinearAlgebra.Util(Numeric,ℝ)
23
24lift1F :: (Vector t -> Vector t) -> Static n (Vector t) -> Static n (Vector t)
25lift1F f (Static v) = Static (f v)
26
27lift2F :: (Vector t -> Vector t -> Vector t) -> Static n (Vector t) -> Static n (Vector t) -> Static n (Vector t)
28lift2F f (Static u) (Static v) = Static (f u v)
29
30newtype Static (n :: Nat) t = Static { ddata :: t } deriving Show
31
32type R n = Static n (Vector ℝ)
33
34
35infixl 4 &
36(&) :: R n -> ℝ -> R (n+1)
37Static v & x = Static (vjoin [v, scalar x])
38
39vect0 :: R 0
40vect0 = Static (fromList[])
41
42sScalar :: ℝ -> R 1
43sScalar = Static . scalar
44
45
46vect2 :: ℝ -> ℝ -> R 2
47vect2 x1 x2 = Static (fromList [x1,x2])
48
49vect3 :: ℝ -> ℝ -> ℝ -> R 3
50vect3 x1 x2 x3 = Static (fromList [x1,x2,x3])
51
52
53
54
55
56
57instance forall n t . (KnownNat n, Num (Vector t), Numeric t )=> Num (Static n (Vector t))
58 where
59 (+) = lift2F add
60 (*) = lift2F mul
61 (-) = lift2F sub
62 abs = lift1F abs
63 signum = lift1F signum
64 negate = lift1F (scale (-1))
65 fromInteger x = Static (konst (fromInteger x) d)
66 where
67 d = fromIntegral . natVal $ (undefined :: Proxy n)
68
69data Proxy :: Nat -> *
70