From 7430630fa0504296b796223e01cbd417b88650ef Mon Sep 17 00:00:00 2001
From: Alberto Ruiz <aruiz@um.es>
Date: Mon, 4 Jun 2007 19:10:28 +0000
Subject: separation of Internal

---
 examples/pru.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 44 insertions(+), 2 deletions(-)

(limited to 'examples')

diff --git a/examples/pru.hs b/examples/pru.hs
index 963ee17..d6dc5d4 100644
--- a/examples/pru.hs
+++ b/examples/pru.hs
@@ -1,7 +1,10 @@
 --{-# OPTIONS_GHC  #-}
 --module Main where
 
-import Data.Packed.Internal
+import Data.Packed.Internal.Vector
+import Data.Packed.Internal.Matrix
+import Data.Packed.Internal.Tensor
+
 import Complex
 import Numeric(showGFloat)
 import Data.List(transpose,intersperse)
@@ -50,4 +53,43 @@ rd = (2><2)
  [  43492.0,  50572.0
  , 102550.0, 119242.0 ]
 
-main = print $ r |=| rd
+main = do
+    print $ r |=| rd
+    print $ foldl part t [("p",1),("r",2),("q",0)]
+
+t = T [(4,(Covariant,"p")),(2,(Covariant,"q")),(3,(Contravariant,"r"))] $ fromList [1..24::Double]
+
+
+findIdx name t = ((d1,d2),m) where
+    (d1,d2) = span (\(_,(_,n)) -> n /=name) (dims t)
+    c = product (map fst (tail d2))
+    m = matrixFromVector RowMajor c (ten t)
+
+
+putFirstIdx name t =
+    if null d1
+        then (nd,m)
+        else (nd,m')
+    where ((d1,d2),m) = findIdx name t
+          m' = trans $ matrixFromVector RowMajor (fst $ head d2) $ dat m
+          nd = d2++d1
+
+part t (name,k) = if k<0 || k>=l
+                    then error $ "part "++show (name,k)++" out of range in "++show t
+                    else T {dims = ds, ten = toRows m !! k}
+    where (d:ds,m) = putFirstIdx name t
+          (l,_) = d
+
+parts t name = map f (toRows m) 
+    where (d:ds,m) = putFirstIdx name t
+          (l,_) = d
+          f t = T {dims=ds, ten=t}
+
+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]
+
+--contract1 t name1 name2 = map head $ zipWith drop [0..] (map (flip parts name2) (parts t name1))
+
+--sumT ls = foldl (zipWith (+)) [0,0..] (map (toList.ten) ls)
+
+on f g = \x y -> f (g x) (g y)
\ No newline at end of file
-- 
cgit v1.2.3