summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal/Tensor.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2007-06-29 17:57:57 +0000
committerAlberto Ruiz <aruiz@um.es>2007-06-29 17:57:57 +0000
commit04c76641caa9e1184fe504c584ddeb5420e994d6 (patch)
treec76d8742575c99ce9668a3cb8cb62f3441452720 /lib/Data/Packed/Internal/Tensor.hs
parente36c04dca536caa42b41a4280d3f21375219970d (diff)
more work on tensors
Diffstat (limited to 'lib/Data/Packed/Internal/Tensor.hs')
-rw-r--r--lib/Data/Packed/Internal/Tensor.hs57
1 files changed, 22 insertions, 35 deletions
diff --git a/lib/Data/Packed/Internal/Tensor.hs b/lib/Data/Packed/Internal/Tensor.hs
index dedbb9c..4430ebc 100644
--- a/lib/Data/Packed/Internal/Tensor.hs
+++ b/lib/Data/Packed/Internal/Tensor.hs
@@ -168,10 +168,7 @@ compatIdx t1 n1 t2 n2 = compatIdxAux d1 d2 where
168 d2 = head $ snd $ fst $ findIdx n2 t2 168 d2 = head $ snd $ fst $ findIdx n2 t2
169 169
170names :: Tensor t -> [IdxName] 170names :: Tensor t -> [IdxName]
171names t = sort $ map idxName (dims t) 171names t = map idxName (dims t)
172
173normal :: (Field t) => Tensor t -> Tensor t
174normal t = tridx (names t) t
175 172
176 173
177-- sent to Haskell-Cafe by Sebastian Sylvan 174-- sent to Haskell-Cafe by Sebastian Sylvan
@@ -192,42 +189,34 @@ signature l | length (nub l) < length l = 0
192 | otherwise = -1 189 | otherwise = -1
193 190
194scalar x = T [] (fromList [x]) 191scalar x = T [] (fromList [x])
195tensorFromVector (tp,nm) v = T {dims = [IdxDesc (dim v) tp nm] 192tensorFromVector tp v = T {dims = [IdxDesc (dim v) tp "1"], ten = v}
196 , ten = v} 193tensorFromMatrix tpr tpc m = T {dims = [IdxDesc (rows m) tpr "1",IdxDesc (cols m) tpc "2"]
197tensorFromMatrix (tpr,nmr) (tpc,nmc) m = T {dims = [IdxDesc (rows m) tpr nmr,IdxDesc (cols m) tpc nmc] 194 , ten = cdat m}
198 , ten = cdat m}
199
200tvector n v = tensorFromVector (Contravariant,n) v
201tcovector n v = tensorFromVector (Covariant,n) v
202
203
204antisym t = T (dims t) (ten (antisym' (auxrename t)))
205 where
206 scsig t = scalar (signature (nms t)) `rawProduct` t
207 where nms = map idxName . dims
208 195
209 antisym' t = addT $ map (scsig . flip tridx t) (perms (names t)) 196tvector v = tensorFromVector Contravariant v
210 197tcovector v = tensorFromVector Covariant v
211 auxrename (T d v) = T d' v
212 where d' = [IdxDesc n c (show (pos q)) | IdxDesc n c q <- d]
213 pos n = i where Just i = elemIndex n nms
214 nms = map idxName d
215 198
199antisym t = T (dims t) (ten (antisym' (withIdx t seqind)))
200 where antisym' t = addT $ map (scsig . flip tridx t) (perms (names t))
201 scsig t = scalar (signature (nms t)) `rawProduct` t
202 where nms = map idxName . dims
216 203
217norper t = rawProduct t (scalar (recip $ fromIntegral $ fact (rank t))) 204norper t = rawProduct t (scalar (recip $ fromIntegral $ fact (rank t)))
218antinorper t = rawProduct t (scalar (fromIntegral $ fact (rank t))) 205antinorper t = rawProduct t (scalar (fromIntegral $ fact (rank t)))
219 206
220wedge a b = antisym (rawProduct (norper a) (norper b)) 207wedge a b = antisym (rawProduct (norper a) (norper b))
221 208
222a /\ b = wedge a b
223
224normAT t = sqrt $ innerAT t t 209normAT t = sqrt $ innerAT t t
225 210
226innerAT t1 t2 = dot (ten t1) (ten t2) / fromIntegral (fact $ rank t1) 211innerAT t1 t2 = dot (ten t1) (ten t2) / fromIntegral (fact $ rank t1)
227 212
228fact n = product [1..n] 213fact n = product [1..n]
229 214
230leviCivita n = antisym $ foldl1 rawProduct $ zipWith tcovector (map show [1,2..]) (toRows (ident n)) 215seqind' = map return seqind
216seqind = map show [1..]
217
218leviCivita n = antisym $ foldl1 rawProduct $ zipWith withIdx auxbase seqind'
219 where auxbase = map tcovector (toRows (ident n))
231 220
232-- | obtains de dual of the exterior product of a list of X? 221-- | obtains de dual of the exterior product of a list of X?
233dualV vs = foldl' contractionF (leviCivita n) vs 222dualV vs = foldl' contractionF (leviCivita n) vs
@@ -240,17 +229,15 @@ raise (T d v) = T (map raise' d) v
240-- | raises or lowers all the indices of a tensor with a given an (inverse) metric 229-- | raises or lowers all the indices of a tensor with a given an (inverse) metric
241raiseWith = undefined 230raiseWith = undefined
242 231
232dualg f t = f (leviCivita n) `okContract` withIdx t seqind `rawProduct` x
233 where n = idxDim . head . dims $ t
234 x = scalar (recip $ fromIntegral $ fact (rank t))
235
243-- | obtains the dual of a multivector 236-- | obtains the dual of a multivector
244dualMV t = rawProduct (contractions lct ds) x 237dual t = dualg id t
245 where
246 lc = leviCivita n
247 lct = rawProduct lc t
248 nms1 = map idxName (dims lc)
249 nms2 = map idxName (dims t)
250 ds = zip nms1 nms2
251 n = idxDim . head . dims $ t
252 x = scalar (recip $ fromIntegral $ fact (rank t))
253 238
239-- | obtains the dual of a multicovector (with euclidean metric)
240codual t = dualg raise t
254 241
255-- | shows only the relevant components of an antisymmetric tensor 242-- | shows only the relevant components of an antisymmetric tensor
256niceAS t = filter ((/=0.0).fst) $ zip vals base 243niceAS t = filter ((/=0.0).fst) $ zip vals base