1 module Cross (mmerge, couple, cross, mcross, zipzip, dove) where
    2 
    3 mmerge :: [[a]] -> [a]
    4 mmerge xss = mm xss []
    5         where  mm [] [] = []
    6                 mm [] yss = mm yss []
    7                 mm ([] : xss) yss = mm xss yss
    8                 mm ((x : xs) : xss) yss = x : mm xss (xs : yss)
    9 
   10 
   11 dove :: [[a]] -> [a]
   12 dove xss = dd 1 xss -- where
   13 
   14 dd _ [] = []
   15 dd n (xs : xss) = kzip 0 n (dd (n+1) xss) xs
   16 
   17 kzip 0 n as (b : bs) = b : kzip n n as bs
   18 kzip k n (a : as) bs = a : kzip (k-1) n as bs
   19 kzip _ _ [] bs = bs
   20 kzip _ _ as [] = as
   21 
   22 
   23 
   24 couple :: [[a]] -> [[a]]
   25 couple [] = []
   26 couple xss = [ x | (x : _) <- xss ] : couple [ xs | (_ : xs) <- xss ]
   27 
   28 cross :: [a] -> [b] -> [(a, b)]
   29 -- product of two infinite lists
   30 cross [] _ = []; cross _ [] = []
   31 cross (x : xs) (y : ys) = 
   32         (x, y) : mmerge [ [ (x, y') | y' <- ys ]
   33                         , [ (x', y) | x' <- xs ]
   34                         , cross xs ys
   35                         ]
   36 
   37 mcross :: [[a]] -> [[a]]
   38 -- enumerates the dot product
   39 -- mcross [[x11, x12, ..], [x21, x22, ..], .. , [xn1, xn2, ..]]
   40 --      = [[x11, x21, .., xn1], [.. ], .. ]
   41 mcross xss = [ ys | n <- [0..], ys <- mc n xss] where
   42     mc :: Int -> [[a]] -> [[a]]
   43     mc n [xs] = [[xs !! n]]
   44     mc n (xs : xss) = [ (xs !! m) : ys | m <- [0 .. n], ys <- mc (n-m) xss]
   45 
   46 
   47 zipzip :: [a] -> [a] -> [a]
   48 zipzip [] ys = ys; zipzip (x : xs) ys = x : zipzip ys xs
   49