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 _ _      _      = []