Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

A Challenge For Prog

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 :-

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]


Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List