public
Created

Ordered list monad

  • Download Gist
ordlistmonad.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
{-# LANGUAGE MonadComprehensions #-}
 
import Data.List.Ordered
import Data.Ord
import Control.Monad.Trans.Cont
 
fromList :: [a] -> Cont [Vec Double] a
fromList as = cont $ \k -> mergeAllBy (comparing norm) $ map k as
 
toList :: Cont [Vec Double] (Vec Double) -> [Vec Double]
toList = flip runCont return
 
genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = toList [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]
 
data Vec a = Vec a a
deriving (Eq, Show)
 
instance Num a => Num (Vec a) where
(Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
-- ...
 
s .* (Vec x y) = Vec (s*x) (s*y)
norm (Vec x y) = sqrt (x^2 + y^2)
 
test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)
ordlistmonad2.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
{-# LANGUAGE MonadComprehensions #-}
 
import Data.List.Ordered
import Data.Ord
import Control.Monad.Trans.Cont
 
 
fromList :: [a] -> Cont ((r -> r -> Ordering) -> [r]) a
fromList as = cont $ \k cmp -> mergeAllBy cmp $ map (flip k cmp) as
 
orderedBy :: (a -> a -> Ordering) -> Cont ((a -> a -> Ordering) -> [a]) a -> [a]
orderedBy cmp = ($ cmp) . flip runCont (const . return)
 
genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = orderedBy (comparing norm) [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]
 
data Vec a = Vec a a
deriving (Eq, Show)
 
instance Num a => Num (Vec a) where
(Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
-- ...
 
s .* (Vec x y) = Vec (s*x) (s*y)
norm (Vec x y) = sqrt (x^2 + y^2)
 
test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)
ordlistmonad3.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
{-# LANGUAGE MonadComprehensions #-}
 
import Data.List.Ordered
import Data.Ord
import Data.FMList (FMList, fromList)
import Data.Monoid
import Data.Foldable
 
newtype MergeList = MergeList { runMergeList :: [Vec Double] }
instance Monoid MergeList where
mempty = MergeList []
MergeList as `mappend` MergeList bs = MergeList (mergeAllBy (comparing norm) [as, bs])
 
run :: FMList (Vec Double) -> [Vec Double]
run = runMergeList . foldMap (MergeList . return)
 
genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = run [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]
 
data Vec a = Vec a a
deriving (Eq, Show)
 
instance Num a => Num (Vec a) where
(Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
-- ...
 
s .* (Vec x y) = Vec (s*x) (s*y)
norm (Vec x y) = sqrt (x^2 + y^2)
 
test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.