summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Tensor.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2007-06-26 16:57:58 +0000
committerAlberto Ruiz <aruiz@um.es>2007-06-26 16:57:58 +0000
commita749785e839d14fadc47ab4c6e94afdd167bdd21 (patch)
tree2b715bf233aa8e82137621a251b0edf0b32cdd67 /lib/Data/Packed/Tensor.hs
parent3019948b97ba1c177b21ab103823fabe561b3ffe (diff)
tensor refactorization
Diffstat (limited to 'lib/Data/Packed/Tensor.hs')
-rw-r--r--lib/Data/Packed/Tensor.hs82
1 files changed, 79 insertions, 3 deletions
diff --git a/lib/Data/Packed/Tensor.hs b/lib/Data/Packed/Tensor.hs
index 75a9288..68ce9a5 100644
--- a/lib/Data/Packed/Tensor.hs
+++ b/lib/Data/Packed/Tensor.hs
@@ -12,9 +12,85 @@
12-- 12--
13----------------------------------------------------------------------------- 13-----------------------------------------------------------------------------
14 14
15module Data.Packed.Tensor ( 15module Data.Packed.Tensor where
16
17) where
18 16
17import Data.Packed.Matrix
19import Data.Packed.Internal 18import Data.Packed.Internal
20import Complex 19import Complex
20import Data.List(transpose,intersperse,sort,elemIndex,nub,foldl',foldl1')
21
22scalar x = T [] (fromList [x])
23tensorFromVector (tp,nm) v = T {dims = [IdxDesc (dim v) tp nm]
24 , ten = v}
25tensorFromMatrix (tpr,nmr) (tpc,nmc) m = T {dims = [IdxDesc (rows m) tpr nmr,IdxDesc (cols m) tpc nmc]
26 , ten = cdat m}
27
28scsig t = scalar (signature (nms t)) `prod` t
29 where nms = map idxName . dims
30
31antisym' t = addT $ map (scsig . flip tridx t) (perms (names t))
32
33
34auxrename (T d v) = T d' v
35 where d' = [IdxDesc n c (show (pos q)) | IdxDesc n c q <- d]
36 pos n = i where Just i = elemIndex n nms
37 nms = map idxName d
38
39antisym t = T (dims t) (ten (antisym' (auxrename t)))
40
41
42norper t = prod t (scalar (recip $ fromIntegral $ product [1 .. length (dims t)]))
43antinorper t = prod t (scalar (fromIntegral $ product [1 .. length (dims t)]))
44
45
46tvector n v = tensorFromVector (Contravariant,n) v
47tcovector n v = tensorFromVector (Covariant,n) v
48
49wedge a b = antisym (prod (norper a) (norper b))
50
51a /\ b = wedge a b
52
53a <*> b = normal $ prod a b
54
55normAT t = sqrt $ innerAT t t
56
57innerAT t1 t2 = dot (ten t1) (ten t2) / fromIntegral (fact $ length $ dims t1)
58
59fact n = product [1..n]
60
61leviCivita n = antisym $ foldl1 prod $ zipWith tcovector (map show [1,2..]) (toRows (ident n))
62
63contractionF t1 t2 = contraction t1 n1 t2 n2
64 where n1 = fn t1
65 n2 = fn t2
66 fn = idxName . head . dims
67
68
69dualV vs = foldl' contractionF (leviCivita n) vs
70 where n = idxDim . head . dims . head $ vs
71
72raise (T d v) = T (map raise' d) v
73 where raise' idx@IdxDesc {idxType = Covariant } = idx {idxType = Contravariant}
74 raise' idx@IdxDesc {idxType = Contravariant } = idx {idxType = Covariant}
75
76dualMV t = prod (foldl' contract1b (lc <*> t) ds) (scalar (recip $ fromIntegral $ fact (length ds)))
77 where
78 lc = leviCivita n
79 nms1 = map idxName (dims lc)
80 nms2 = map ((++"'").idxName) (dims t)
81 ds = zip nms1 nms2
82 n = idxDim . head . dims $ t
83
84contract1b t (n1,n2) = contract1 t n1 n2
85
86contractions t pairs = foldl' contract1b t pairs
87
88asBase r n = filter (\x-> (x==nub x && x==sort x)) $ sequence $ replicate r [1..n]
89
90partF t i = part t (name,i) where name = idxName . head . dims $ t
91
92niceAS t = filter ((/=0.0).fst) $ zip vals base
93 where vals = map ((`at` 0).ten.foldl' partF t) (map (map pred) base)
94 base = asBase r n
95 r = length (dims t)
96 n = idxDim . head . dims $ t