Cartesian_product3.hs

Cartesian_product3.hs

{-# LANGUAGE RebindableSyntax #-}

module Cartesian_product3 where

import Prelude hiding((>>=), return, Monad, fail)

-- begin help -----

class Applicative m => Monad m where  
    return :: a -> m a  
    (>>=) :: m a -> (a -> m b) -> m b  
    (>>) :: m a -> m b -> m b  
    x >> y = x >>= \_ -> y  
    fail :: String -> m a  
    fail msg = error msg  


instance Monad [] where  
    return x = [x]  
    xs >>= f = concat (map f xs)  
    fail _ = []  



pairs l1 l2 = do
    x <- l1
    y <- l2
    return (x, y)


sequence1 :: (Monad m) => [m t] -> m [t]
sequence1 [] = return []
sequence1 (m:ms) = do
    x <- m
    xs <- sequence1 ms
    return (x:xs)


-- Add type signature will have error 
-- so [[]] is not return []
-- sequence2 :: (Monad m) => [m t] -> m [t]
sequence2 [] = [[]]
sequence2 (list : lists) =
    [ x: xs | x <- list , xs <- sequence2 lists]


liftM2 :: Monad m => (a -> a1 -> r) -> m a -> m a1 -> m r
liftM2 f x y = x >>= \u ->
               y >>= \v ->
               return (f u v)
               
sequence3 = foldr (liftM2 (:)) (return []) 


mapM1 :: Monad  m => (a -> m b) -> [a] -> m [b]
mapM1 f [] = pure []
mapM1 f (x : xs) = (:) <$> f x <*> mapM1 f xs


mapM2 :: Monad  m => (a -> m b) -> [a] -> m [b]
mapM2 f = foldr go (pure []) where
  go x r = (:) <$> f x <*> r


mapM3 :: Monad  m => (a -> m b) -> [a] -> m [b]
mapM3 = (`foldr` pure []) . (((<*>) . fmap (:)) .)



mapM4 :: Monad m => (a -> m b) -> [a] -> m [b]
mapM4 _ []  = return []
mapM4 f (x:xs)  = do
  y <- f x
  ys <- mapM4 f xs
  return (y:ys)


mapM5 :: Monad m => (a -> m b) -> [a] -> m [b]
mapM5 _ []     = return []
mapM5 f (x:xs) = 
    f x           >>=
    \y  -> mapM5  f xs    >>=
    \ys -> return (y:ys)
                 

----  help end  -----

cartProdN9 :: [[a]] -> [[a]]
cartProdN9 [] = return []
cartProdN9 (x:xs) = x >>= \x' -> cartProdN9 xs >>= \xs' -> return (x':xs')

cartProdN10 :: [[a]] -> [[a]]
cartProdN10 = mapM id


cartProdN11 :: [[a]] -> [[a]]
cartProdN11 = sequence