From 978e6d038239af50d70bae2c303f4e45b1879b7a Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 22 Jun 2007 17:33:17 +0000 Subject: refactoring --- examples/pru.hs | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) (limited to 'examples/pru.hs') 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] -- cgit v1.2.3