diff options
Diffstat (limited to 'examples/pru.hs')
-rw-r--r-- | examples/pru.hs | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/examples/pru.hs b/examples/pru.hs index d6dc5d4..bddc08f 100644 --- a/examples/pru.hs +++ b/examples/pru.hs | |||
@@ -55,24 +55,23 @@ rd = (2><2) | |||
55 | 55 | ||
56 | main = do | 56 | main = do |
57 | print $ r |=| rd | 57 | print $ r |=| rd |
58 | print $ foldl part t [("p",1),("q",0),("r",2)] | ||
58 | print $ foldl part t [("p",1),("r",2),("q",0)] | 59 | print $ foldl part t [("p",1),("r",2),("q",0)] |
60 | print $ foldl part t $ reverse [("p",1),("r",2),("q",0)] | ||
59 | 61 | ||
60 | t = T [(4,(Covariant,"p")),(2,(Covariant,"q")),(3,(Contravariant,"r"))] $ fromList [1..24::Double] | 62 | t = T [(4,(Covariant,"p")),(2,(Covariant,"q")),(3,(Contravariant,"r"))] $ fromList [1..24::Double] |
61 | 63 | ||
62 | 64 | ||
63 | findIdx name t = ((d1,d2),m) where | 65 | findIdx name t = ((d1,d2),m) where |
64 | (d1,d2) = span (\(_,(_,n)) -> n /=name) (dims t) | 66 | (d1,d2) = span (\(_,(_,n)) -> n /=name) (dims t) |
65 | c = product (map fst (tail d2)) | 67 | c = product (map fst d2) |
66 | m = matrixFromVector RowMajor c (ten t) | 68 | m = matrixFromVector RowMajor c (ten t) |
67 | 69 | ||
68 | 70 | putFirstIdx name t = (nd,m') | |
69 | putFirstIdx name t = | ||
70 | if null d1 | ||
71 | then (nd,m) | ||
72 | else (nd,m') | ||
73 | where ((d1,d2),m) = findIdx name t | 71 | where ((d1,d2),m) = findIdx name t |
74 | m' = trans $ matrixFromVector RowMajor (fst $ head d2) $ dat m | 72 | m' = matrixFromVector RowMajor c $ cdat $ trans m |
75 | nd = d2++d1 | 73 | nd = d2++d1 |
74 | c = dim (ten t) `div` (fst $ head d2) | ||
76 | 75 | ||
77 | part t (name,k) = if k<0 || k>=l | 76 | part t (name,k) = if k<0 || k>=l |
78 | then error $ "part "++show (name,k)++" out of range in "++show t | 77 | then error $ "part "++show (name,k)++" out of range in "++show t |
@@ -88,8 +87,13 @@ parts t name = map f (toRows m) | |||
88 | t1 = T [(4,(Covariant,"p")),(4,(Contravariant,"q")),(2,(Covariant,"r"))] $ fromList [1..32::Double] | 87 | t1 = T [(4,(Covariant,"p")),(4,(Contravariant,"q")),(2,(Covariant,"r"))] $ fromList [1..32::Double] |
89 | t2 = T [(4,(Covariant,"p")),(4,(Contravariant,"q"))] $ fromList [1..16::Double] | 88 | t2 = T [(4,(Covariant,"p")),(4,(Contravariant,"q"))] $ fromList [1..16::Double] |
90 | 89 | ||
91 | --contract1 t name1 name2 = map head $ zipWith drop [0..] (map (flip parts name2) (parts t name1)) | 90 | contract1 t name1 name2 = map head $ zipWith drop [0..] (map (flip parts name2) (parts t name1)) |
91 | |||
92 | sumT ls = foldl (zipWith (+)) [0,0..] (map (toList.ten) ls) | ||
92 | 93 | ||
93 | --sumT ls = foldl (zipWith (+)) [0,0..] (map (toList.ten) ls) | 94 | on f g = \x y -> f (g x) (g y) |
94 | 95 | ||
95 | on f g = \x y -> f (g x) (g y) \ No newline at end of file | 96 | contract t1 n1 t2 n2 = T (tail d1++tail d2) (cdat m) |
97 | where (d1,m1) = putFirstIdx n1 t1 | ||
98 | (d2,m2) = putFirstIdx n2 t2 | ||
99 | m = multiply RowMajor (trans m2) m1 \ No newline at end of file | ||