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