module GentlemanSeq where import Data.List import Debug.Trace -- gentleman uses a torus to multiply 2 matices -- see http://www.mathematik.uni-marburg.de/~loogen/Lehre/ws08/ParProg/Folien/ParProg1.pdf gentlemanMul :: (Num a) => [[a]] -> [[a]] -> [[a]] gentlemanMul ass bss = torus f ass' ass' bss' bss' where -- function on torus elements -- f :: [a] -> [a] -> [a] -> [a] -> ([a],[a],[a],[a]) f fromR _ fromD _ = (take n fromR, [], take n fromD, [], out) where out = foldl1 (+) $ zipWith (*) fromR fromD n = (length bss -1) -- pre-rotation ass' = zipWith upRot [0..] ass bss' = transpose $ zipWith upRot [0..] (transpose bss) upRot i xss = xss2 ++ xss1 where (xss1,xss2) = splitAt i xss torus :: ([lr] -> [rr] -> [ur] -> [dr] -> ([lr],[rr],[ur],[dr],res)) -- ^worker function (applied to each torus element) -> [[lr]] -- ^torus input (left rotate) -> [[rr]] -- ^torus input (right rotate) -> [[ur]] -- ^torus input (up rotate) -> [[dr]] -- ^torus input (down rotate) -> [[res]] -- ^torus result torus f lrInit rrInit urInit drInit = res where -- element-wise conses the elements of 2 matrices nestCons :: [[a]] -> [[[a]]] -> [[[a]]] nestCons init stream = lazyZipWith (lazyZipWith (:)) init stream fromR = nestCons lrInit fromR' --streams from right with init elements as heads fromL = nestCons rrInit fromL' --streams from left with init elements as heads fromD = nestCons urInit fromD' --streams from down with init elements as heads fromU = nestCons drInit fromU' --streams from up with init elements as heads -- streams from one side are transformed to streams to the opposite side + final results are produced (toL,toR,toU,toD,res) = unzip5 $ map unzip5 $ zipWith4 (zipWith4 f) fromR fromL fromD fromU --f has to now when to finalize lists because of circular dependencies -- 4 matrices of outgoing streams are rotated each one direction to build the 4 matrices of incoming streams upRot (xs:mx) = mx ++ [xs] downRot mx = last mx : init mx rightRot = (transpose . downRot . transpose) leftRot = (transpose . upRot . transpose) fromD, fromD' :: [[[ur]]] fromD' = upRot toU fromU,fromU' :: [[[dr]]] fromU' = downRot toD fromL,fromL' :: [[[rr]]] fromL' = rightRot toR fromR,fromR' :: [[[lr]]] fromR' = leftRot toL lazyZipWith :: (a->b->c) -> [a]->[b]->[c] lazyZipWith f (a:as) ~(b:bs) = f a b : lazyZipWith f as bs lazyZipWith _ _ _ = []