diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Internal/Tensor.hs | 57 |
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 | ||
170 | names :: Tensor t -> [IdxName] | 170 | names :: Tensor t -> [IdxName] |
171 | names t = sort $ map idxName (dims t) | 171 | names t = map idxName (dims t) |
172 | |||
173 | normal :: (Field t) => Tensor t -> Tensor t | ||
174 | normal 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 | ||
194 | scalar x = T [] (fromList [x]) | 191 | scalar x = T [] (fromList [x]) |
195 | tensorFromVector (tp,nm) v = T {dims = [IdxDesc (dim v) tp nm] | 192 | tensorFromVector tp v = T {dims = [IdxDesc (dim v) tp "1"], ten = v} |
196 | , ten = v} | 193 | tensorFromMatrix tpr tpc m = T {dims = [IdxDesc (rows m) tpr "1",IdxDesc (cols m) tpc "2"] |
197 | tensorFromMatrix (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 | |||
200 | tvector n v = tensorFromVector (Contravariant,n) v | ||
201 | tcovector n v = tensorFromVector (Covariant,n) v | ||
202 | |||
203 | |||
204 | antisym 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)) | 196 | tvector v = tensorFromVector Contravariant v |
210 | 197 | tcovector 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 | ||
199 | antisym 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 | ||
217 | norper t = rawProduct t (scalar (recip $ fromIntegral $ fact (rank t))) | 204 | norper t = rawProduct t (scalar (recip $ fromIntegral $ fact (rank t))) |
218 | antinorper t = rawProduct t (scalar (fromIntegral $ fact (rank t))) | 205 | antinorper t = rawProduct t (scalar (fromIntegral $ fact (rank t))) |
219 | 206 | ||
220 | wedge a b = antisym (rawProduct (norper a) (norper b)) | 207 | wedge a b = antisym (rawProduct (norper a) (norper b)) |
221 | 208 | ||
222 | a /\ b = wedge a b | ||
223 | |||
224 | normAT t = sqrt $ innerAT t t | 209 | normAT t = sqrt $ innerAT t t |
225 | 210 | ||
226 | innerAT t1 t2 = dot (ten t1) (ten t2) / fromIntegral (fact $ rank t1) | 211 | innerAT t1 t2 = dot (ten t1) (ten t2) / fromIntegral (fact $ rank t1) |
227 | 212 | ||
228 | fact n = product [1..n] | 213 | fact n = product [1..n] |
229 | 214 | ||
230 | leviCivita n = antisym $ foldl1 rawProduct $ zipWith tcovector (map show [1,2..]) (toRows (ident n)) | 215 | seqind' = map return seqind |
216 | seqind = map show [1..] | ||
217 | |||
218 | leviCivita 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? |
233 | dualV vs = foldl' contractionF (leviCivita n) vs | 222 | dualV 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 |
241 | raiseWith = undefined | 230 | raiseWith = undefined |
242 | 231 | ||
232 | dualg 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 |
244 | dualMV t = rawProduct (contractions lct ds) x | 237 | dual 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) | ||
240 | codual 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 |
256 | niceAS t = filter ((/=0.0).fst) $ zip vals base | 243 | niceAS t = filter ((/=0.0).fst) $ zip vals base |