refactoring

1 files changed, 25 insertions, 20 deletions

diff --git a/examples/pru.hs b/examples/pru.hs
index fb33962..f855bce 100644
--- a/examples/pru.hs
+++ b/examples/pru.hs
@@ -52,12 +52,14 @@ main = do
     print $ foldl part t [("p",1),("r",2),("q",0)]
     print $ foldl part t $ reverse [("p",1),("r",2),("q",0)]
 
-t = T [(4,(Covariant,"p")),(2,(Covariant,"q")),(3,(Contravariant,"r"))] $ fromList [1..24::Double]
+t = T [IdxDesc 4 Covariant "p",IdxDesc 2 Covariant "q" ,IdxDesc 3 Contravariant "r"]
+    $ fromList [1..24::Double]
 
 
-
-t1 = T [(4,(Covariant,"p")),(4,(Contravariant,"q")),(2,(Covariant,"r"))] $ fromList [1..32::Double]
-t2 = T [(4,(Covariant,"p")),(4,(Contravariant,"q"))] $ fromList [1..16::Double]
+t1 = T [IdxDesc 4 Covariant "p",IdxDesc 4 Contravariant "q" ,IdxDesc 2 Covariant "r"]
+    $ fromList [1..32::Double]
+t2 = T [IdxDesc 4 Covariant "p",IdxDesc 4 Contravariant "q"] 
+    $ fromList [1..16::Double]
 
 
 
@@ -72,15 +74,18 @@ e i n = fromList [ delta k i | k <- [1..n]]
 diagl = diag.fromList
 
 scalar x = T [] (fromList [x])
-tensorFromVector idx v = T {dims = [(dim v,idx)], ten = v}
-tensorFromMatrix idxr idxc m = T {dims = [(rows m,idxr),(cols m,idxc)], ten = cdat m}
+tensorFromVector (tp,nm) v = T {dims = [IdxDesc (dim v) tp nm]
+                                       , ten = v}
+tensorFromMatrix (tpr,nmr) (tpc,nmc) m = T {dims = [IdxDesc (rows m) tpr nmr,IdxDesc (cols m) tpc nmc]
+                                           , ten = cdat m}
 
 td = tensorFromMatrix (Contravariant,"i") (Covariant,"j") $ diagl [1..4] :: Tensor Double
 
 tn = tensorFromMatrix (Contravariant,"i") (Covariant,"j") $ (2><3) [1..6] :: Tensor Double
 tt = tensorFromMatrix (Contravariant,"i") (Covariant,"j") $ (2><3) [1..6] :: Tensor Double
 
-tq = T [(3,(Covariant,"p")),(2,(Covariant,"q")),(2,(Covariant,"r"))] $ fromList [11 .. 22] :: Tensor Double
+tq = T  [IdxDesc 3 Covariant "p",IdxDesc 2 Covariant "q" ,IdxDesc 2 Covariant "r"]
+    $ fromList [11 .. 22] :: Tensor Double
 
 r1 = contraction tt "j" tq "p"
 r1' = contraction' tt "j" tq "p"
@@ -101,7 +106,7 @@ pru = do
     print $ foldl part t2 [("j'",0),("p",1),("r",1)]
 
 scsig t = scalar (signature (nms t)) `prod` t
-    where nms = map (snd.snd) . dims
+    where nms = map idxName . dims
 
 antisym' t = addT $ map (scsig . flip tridx t) (perms (names t))
 
@@ -115,9 +120,9 @@ antisym' t = addT $ map (scsig . flip tridx t) (perms (names t))
 -}
 
 auxrename (T d v) = T d' v
-    where d' = [(n,(c,show (pos q))) | (n,(c,q)) <- d]
+    where d' = [IdxDesc n c (show (pos q)) | IdxDesc n c q <- d]
           pos n = i where Just i = elemIndex n nms
-          nms = map (snd.snd) d
+          nms = map idxName d
 
 antisym t = T (dims t) (ten (antisym' (auxrename t)))
 
@@ -156,16 +161,16 @@ l1 = vector "p" [0,0,0,1]
 l2 = vector "q" [1,0,0,1]
 l3 = vector "r" [0,1,0,1]
 
-leviCivita n = antisym $ foldl1 prod $ zipWith tcovector (map show [1..]) (toRows (ident n))
+leviCivita n = antisym $ foldl1 prod $ zipWith tcovector (map show [1,2..]) (toRows (ident n))
 
 contractionF t1 t2 = contraction t1 n1 t2 n2
     where n1 = fn t1
           n2 = fn t2
-          fn = snd . snd . head . dims
+          fn = idxName . head . dims
 
 
 dualV vs = foldl' contractionF (leviCivita n) vs
-    where n = fst . head . dims . head $ vs
+    where n = idxDim . head . dims . head $ vs
 
 
 dual1 = foldl' contractionF (leviCivita 3) [u,v]
@@ -184,16 +189,16 @@ x3 = vector "r" [-3,-1,-1]
 x4 = vector "s" [12,0,3]
 
 raise (T d v) = T (map raise' d) v
-    where raise' (n,(Covariant,s)) = (n,(Contravariant,s))
-          raise' (n,(Contravariant,s)) = (n,(Covariant,s))
+    where raise' idx@IdxDesc {idxType = Covariant } = idx {idxType = Contravariant}
+          raise' idx@IdxDesc {idxType = Contravariant } = idx {idxType = Covariant}
 
 dualMV t = prod (foldl' contract1b (lc <*> t) ds) (scalar (recip $ fromIntegral $ fact (length ds)))
     where
         lc = leviCivita n
-        nms1 = map (snd.snd) (dims lc)
-        nms2 = map ((++"'").snd.snd) (dims t)
+        nms1 = map idxName (dims lc)
+        nms2 = map ((++"'").idxName) (dims t)
         ds = zip nms1 nms2
-        n = fst . head . dims $ t
+        n = idxDim . head . dims $ t
 
 -- intersection of two lines :-)
 -- > raise $ dualMV $ raise $ dualMV (x1/\x2) /\ dualV [x3,x4]
@@ -211,7 +216,7 @@ y4 = vector "s" [12,0,0,3]
 
 asBase r n = filter (\x-> (x==nub x && x==sort x)) $ sequence $ replicate r [1..n]
 
-partF t i = part t (name,i) where name = snd . snd . head . dims $ t
+partF t i = part t (name,i) where name = idxName . head . dims $ t
 
 --partL = foldl' partF
 
@@ -219,7 +224,7 @@ niceAS t = filter ((/=0.0).fst) $ zip vals base
     where vals = map ((`at` 0).ten.foldl' partF t) (map (map pred) base)
           base = asBase r n
           r = length (dims t)
-          n = fst . head . dims $ t
+          n = idxDim . head . dims $ t
 
 z1 = vector "p" [0,0,0,1]
 z2 = vector "q" [1,0,0,1]