1
Name:
Anonymous
2008-05-16 8:12
No, I'm not a student looking to get my program written for me.
I'm just trying to find the most optimized solution to a problem, and at the same time it makes a decent challenge for /prog/.
The problem :-
5
Name:
Simon Peyote Joints
2008-05-16 9:04
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
import Control.Monad.State
import Control.Monad.Reader
newtype Permu s a = Permu { unPermu :: StateT [s] [] a }
deriving (Functor, Monad, MonadPlus)
runPermu :: Permu s a -> [s] -> [(a, [s])]
runPermu = runStateT . unPermu
evalPermu :: Permu s a -> [s] -> [a]
evalPermu p xs = map fst $ runPermu p xs
execPermu :: Permu s a -> [s] -> [[s]]
execPermu p xs = map snd $ runPermu p xs
draw :: Permu s s
draw = Permu $ do
s <- get
(x, xs) <- lift $ select' s
put xs
return x
select' :: [a] -> [(a, [a])]
select' [] = []
select' (x : xs) = (x, xs) : map (fmap (x :)) (select' xs)
pruneIf :: (s -> Bool) -> Permu s ()
pruneIf f = Permu $ do
modify . filter $ not . f
prune :: (Eq s) => s -> Permu s ()
prune s = pruneIf (s ==)
select :: [a] -> Permu s a
select = Permu . lift
instance MonadReader [s] (Permu s) where
ask = Permu get
local f p = select . evalPermu p . f =<< ask
permute :: [a] -> [[a]]
permute = join . liftM evalPermu . mapM . return $ draw
main :: IO ()
main = putStr . unlines . map show . permute $ [1, 2, 3]