-- | Miscellaneous helper functions used internally {-# LANGUAGE BangPatterns, PolyKinds, GeneralizedNewtypeDeriving #-} module Math.Combinat.Helper where -------------------------------------------------------------------------------- import Control.Monad import Control.Applicative ( Applicative(..) ) -- required before AMP (before GHC 7.10) import Data.Functor.Identity import Data.List import Data.Ord import Data.Proxy import Data.Set (Set) ; import qualified Data.Set as Set import Data.Map (Map) ; import qualified Data.Map as Map import Debug.Trace import System.Random import Control.Monad.Trans.State -------------------------------------------------------------------------------- -- * debugging debug :: Show a => a -> b -> b debug :: a -> b -> b debug a x b y = String -> b -> b forall a. String -> a -> a trace (String "-- " String -> String -> String forall a. [a] -> [a] -> [a] ++ a -> String forall a. Show a => a -> String show a x String -> String -> String forall a. [a] -> [a] -> [a] ++ String "\n") b y -------------------------------------------------------------------------------- -- * pairs swap :: (a,b) -> (b,a) swap :: (a, b) -> (b, a) swap (a x,b y) = (b y,a x) pairs :: [a] -> [(a,a)] pairs :: [a] -> [(a, a)] pairs = [a] -> [(a, a)] forall b. [b] -> [(b, b)] go where go :: [b] -> [(b, b)] go (b x:xs :: [b] xs@(b y:[b] _)) = (b x,b y) (b, b) -> [(b, b)] -> [(b, b)] forall a. a -> [a] -> [a] : [b] -> [(b, b)] go [b] xs go [b] _ = [] pairsWith :: (a -> a -> b) -> [a] -> [b] pairsWith :: (a -> a -> b) -> [a] -> [b] pairsWith a -> a -> b f = [a] -> [b] go where go :: [a] -> [b] go (a x:xs :: [a] xs@(a y:[a] _)) = a -> a -> b f a x a y b -> [b] -> [b] forall a. a -> [a] -> [a] : [a] -> [b] go [a] xs go [a] _ = [] -------------------------------------------------------------------------------- -- * lists {-# SPECIALIZE sum' :: [Int] -> Int #-} {-# SPECIALIZE sum' :: [Integer] -> Integer #-} sum' :: Num a => [a] -> a sum' :: [a] -> a sum' = (a -> a -> a) -> a -> [a] -> a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' a -> a -> a forall a. Num a => a -> a -> a (+) a 0 interleave :: [a] -> [a] -> [a] interleave :: [a] -> [a] -> [a] interleave (a x:[a] xs) (a y:[a] ys) = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : a y a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] interleave [a] xs [a] ys interleave [a x] [] = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : [] interleave [] [] = [] interleave [a] _ [a] _ = String -> [a] forall a. HasCallStack => String -> a error String "interleave: shouldn't happen" evens, odds :: [a] -> [a] evens :: [a] -> [a] evens (a x:[a] xs) = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] -> [a] forall a. [a] -> [a] odds [a] xs evens [] = [] odds :: [a] -> [a] odds (a x:[a] xs) = [a] -> [a] forall a. [a] -> [a] evens [a] xs odds [] = [] -------------------------------------------------------------------------------- -- * multiplication -- | Product of list of integers, but in interleaved order (for a list of big numbers, -- it should be faster than the linear order) productInterleaved :: [Integer] -> Integer productInterleaved :: [Integer] -> Integer productInterleaved = [Integer] -> Integer forall a. Num a => [a] -> a go where go :: [a] -> a go [] = a 1 go [a x] = a x go [a x,a y] = a xa -> a -> a forall a. Num a => a -> a -> a *a y go [a] list = [a] -> a go ([a] -> [a] forall a. [a] -> [a] evens [a] list) a -> a -> a forall a. Num a => a -> a -> a * [a] -> a go ([a] -> [a] forall a. [a] -> [a] odds [a] list) -- | Faster implementation of @product [ i | i <- [a+1..b] ]@ productFromTo :: Integral a => a -> a -> Integer productFromTo :: a -> a -> Integer productFromTo = a -> a -> Integer forall a p. (Num p, Integral a) => a -> a -> p go where go :: a -> a -> p go !a a !a b | a dif a -> a -> Bool forall a. Ord a => a -> a -> Bool < a 1 = p 1 | a dif a -> a -> Bool forall a. Ord a => a -> a -> Bool < a 5 = [p] -> p forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a product [ a -> p forall a b. (Integral a, Num b) => a -> b fromIntegral a i | a i<-[a aa -> a -> a forall a. Num a => a -> a -> a +a 1..a b] ] | Bool otherwise = a -> a -> p go a a a half p -> p -> p forall a. Num a => a -> a -> a * a -> a -> p go a half a b where dif :: a dif = a b a -> a -> a forall a. Num a => a -> a -> a - a a half :: a half = a -> a -> a forall a. Integral a => a -> a -> a div (a aa -> a -> a forall a. Num a => a -> a -> a +a ba -> a -> a forall a. Num a => a -> a -> a +a 1) a 2 -- | Faster implementation of product @[ i | i <- [a+1,a+3,..b] ]@ productFromToStride2 :: Integral a => a -> a -> Integer productFromToStride2 :: a -> a -> Integer productFromToStride2 = a -> a -> Integer forall a p. (Num p, Integral a) => a -> a -> p go where go :: t -> t -> p go !t a !t b | t dif t -> t -> Bool forall a. Ord a => a -> a -> Bool < t 1 = p 1 | t dif t -> t -> Bool forall a. Ord a => a -> a -> Bool < t 9 = [p] -> p forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a product [ t -> p forall a b. (Integral a, Num b) => a -> b fromIntegral t i | t i<-[t at -> t -> t forall a. Num a => a -> a -> a +t 1,t at -> t -> t forall a. Num a => a -> a -> a +t 3..t b] ] | Bool otherwise = t -> t -> p go t a t half p -> p -> p forall a. Num a => a -> a -> a * t -> t -> p go t half t b where dif :: t dif = t b t -> t -> t forall a. Num a => a -> a -> a - t a half :: t half = t a t -> t -> t forall a. Num a => a -> a -> a + t 2t -> t -> t forall a. Num a => a -> a -> a *(t -> t -> t forall a. Integral a => a -> a -> a div t dif t 4) -------------------------------------------------------------------------------- -- * equality and ordering equating :: Eq b => (a -> b) -> a -> a -> Bool equating :: (a -> b) -> a -> a -> Bool equating a -> b f a x a y = (a -> b f a x b -> b -> Bool forall a. Eq a => a -> a -> Bool == a -> b f a y) reverseOrdering :: Ordering -> Ordering reverseOrdering :: Ordering -> Ordering reverseOrdering Ordering LT = Ordering GT reverseOrdering Ordering GT = Ordering LT reverseOrdering Ordering EQ = Ordering EQ reverseComparing :: Ord b => (a -> b) -> a -> a -> Ordering reverseComparing :: (a -> b) -> a -> a -> Ordering reverseComparing a -> b f a x a y = b -> b -> Ordering forall a. Ord a => a -> a -> Ordering compare (a -> b f a y) (a -> b f a x) reverseCompare :: Ord a => a -> a -> Ordering reverseCompare :: a -> a -> Ordering reverseCompare a x a y = a -> a -> Ordering forall a. Ord a => a -> a -> Ordering compare a y a x -- reverseOrdering $ compare x y reverseSort :: Ord a => [a] -> [a] reverseSort :: [a] -> [a] reverseSort = (a -> a -> Ordering) -> [a] -> [a] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy a -> a -> Ordering forall a. Ord a => a -> a -> Ordering reverseCompare groupSortBy :: (Eq b, Ord b) => (a -> b) -> [a] -> [[a]] groupSortBy :: (a -> b) -> [a] -> [[a]] groupSortBy a -> b f = (a -> a -> Bool) -> [a] -> [[a]] forall a. (a -> a -> Bool) -> [a] -> [[a]] groupBy ((a -> b) -> a -> a -> Bool forall b a. Eq b => (a -> b) -> a -> a -> Bool equating a -> b f) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]] forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> a -> Ordering) -> [a] -> [a] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy ((a -> b) -> a -> a -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing a -> b f) nubOrd :: Ord a => [a] -> [a] nubOrd :: [a] -> [a] nubOrd = Set a -> [a] -> [a] forall a. Ord a => Set a -> [a] -> [a] worker Set a forall a. Set a Set.empty where worker :: Set a -> [a] -> [a] worker Set a _ [] = [] worker Set a s (a x:[a] xs) | a -> Set a -> Bool forall a. Ord a => a -> Set a -> Bool Set.member a x Set a s = Set a -> [a] -> [a] worker Set a s [a] xs | Bool otherwise = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : Set a -> [a] -> [a] worker (a -> Set a -> Set a forall a. Ord a => a -> Set a -> Set a Set.insert a x Set a s) [a] xs -------------------------------------------------------------------------------- -- * increasing \/ decreasing sequences {-# SPECIALIZE isWeaklyIncreasing :: [Int] -> Bool #-} isWeaklyIncreasing :: Ord a => [a] -> Bool isWeaklyIncreasing :: [a] -> Bool isWeaklyIncreasing = [a] -> Bool forall a. Ord a => [a] -> Bool go where go :: [a] -> Bool go [a] xs = case [a] xs of (a a:rest :: [a] rest@(a b:[a] _)) -> a a a -> a -> Bool forall a. Ord a => a -> a -> Bool <= a b Bool -> Bool -> Bool && [a] -> Bool go [a] rest [a _] -> Bool True [] -> Bool True {-# SPECIALIZE isStrictlyIncreasing :: [Int] -> Bool #-} isStrictlyIncreasing :: Ord a => [a] -> Bool isStrictlyIncreasing :: [a] -> Bool isStrictlyIncreasing = [a] -> Bool forall a. Ord a => [a] -> Bool go where go :: [a] -> Bool go [a] xs = case [a] xs of (a a:rest :: [a] rest@(a b:[a] _)) -> a a a -> a -> Bool forall a. Ord a => a -> a -> Bool < a b Bool -> Bool -> Bool && [a] -> Bool go [a] rest [a _] -> Bool True [] -> Bool True {-# SPECIALIZE isWeaklyDecreasing :: [Int] -> Bool #-} isWeaklyDecreasing :: Ord a => [a] -> Bool isWeaklyDecreasing :: [a] -> Bool isWeaklyDecreasing = [a] -> Bool forall a. Ord a => [a] -> Bool go where go :: [a] -> Bool go [a] xs = case [a] xs of (a a:rest :: [a] rest@(a b:[a] _)) -> a a a -> a -> Bool forall a. Ord a => a -> a -> Bool >= a b Bool -> Bool -> Bool && [a] -> Bool go [a] rest [a _] -> Bool True [] -> Bool True {-# SPECIALIZE isStrictlyDecreasing :: [Int] -> Bool #-} isStrictlyDecreasing :: Ord a => [a] -> Bool isStrictlyDecreasing :: [a] -> Bool isStrictlyDecreasing = [a] -> Bool forall a. Ord a => [a] -> Bool go where go :: [a] -> Bool go [a] xs = case [a] xs of (a a:rest :: [a] rest@(a b:[a] _)) -> a a a -> a -> Bool forall a. Ord a => a -> a -> Bool > a b Bool -> Bool -> Bool && [a] -> Bool go [a] rest [a _] -> Bool True [] -> Bool True -------------------------------------------------------------------------------- -- * first \/ last -- | The boolean argument will @True@ only for the last element mapWithLast :: (Bool -> a -> b) -> [a] -> [b] mapWithLast :: (Bool -> a -> b) -> [a] -> [b] mapWithLast Bool -> a -> b f = [a] -> [b] go where go :: [a] -> [b] go (a x : []) = Bool -> a -> b f Bool True a x b -> [b] -> [b] forall a. a -> [a] -> [a] : [] go (a x : [a] xs) = Bool -> a -> b f Bool False a x b -> [b] -> [b] forall a. a -> [a] -> [a] : [a] -> [b] go [a] xs mapWithFirst :: (Bool -> a -> b) -> [a] -> [b] mapWithFirst :: (Bool -> a -> b) -> [a] -> [b] mapWithFirst Bool -> a -> b f = Bool -> [a] -> [b] go Bool True where go :: Bool -> [a] -> [b] go Bool b (a x:[a] xs) = Bool -> a -> b f Bool b a x b -> [b] -> [b] forall a. a -> [a] -> [a] : Bool -> [a] -> [b] go Bool False [a] xs mapWithFirstLast :: (Bool -> Bool -> a -> b) -> [a] -> [b] mapWithFirstLast :: (Bool -> Bool -> a -> b) -> [a] -> [b] mapWithFirstLast Bool -> Bool -> a -> b f = Bool -> [a] -> [b] go Bool True where go :: Bool -> [a] -> [b] go Bool b (a x : []) = Bool -> Bool -> a -> b f Bool b Bool True a x b -> [b] -> [b] forall a. a -> [a] -> [a] : [] go Bool b (a x : [a] xs) = Bool -> Bool -> a -> b f Bool b Bool False a x b -> [b] -> [b] forall a. a -> [a] -> [a] : Bool -> [a] -> [b] go Bool False [a] xs -------------------------------------------------------------------------------- -- * older helpers for ASCII drawing -- | extend lines with spaces so that they have the same line mkLinesUniformWidth :: [String] -> [String] mkLinesUniformWidth :: [String] -> [String] mkLinesUniformWidth [String] old = (Int -> String -> String) -> [Int] -> [String] -> [String] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Int -> String -> String worker [Int] ls [String] old where ls :: [Int] ls = (String -> Int) -> [String] -> [Int] forall a b. (a -> b) -> [a] -> [b] map String -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [String] old m :: Int m = [Int] -> Int forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum [Int] ls worker :: Int -> String -> String worker Int l String s = String s String -> String -> String forall a. [a] -> [a] -> [a] ++ Int -> Char -> String forall a. Int -> a -> [a] replicate (Int mInt -> Int -> Int forall a. Num a => a -> a -> a -Int l) Char ' ' mkBlocksUniformHeight :: [[String]] -> [[String]] mkBlocksUniformHeight :: [[String]] -> [[String]] mkBlocksUniformHeight [[String]] old = (Int -> [String] -> [String]) -> [Int] -> [[String]] -> [[String]] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Int -> [String] -> [String] worker [Int] ls [[String]] old where ls :: [Int] ls = ([String] -> Int) -> [[String]] -> [Int] forall a b. (a -> b) -> [a] -> [b] map [String] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [[String]] old m :: Int m = [Int] -> Int forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum [Int] ls worker :: Int -> [String] -> [String] worker Int l [String] s = [String] s [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ Int -> String -> [String] forall a. Int -> a -> [a] replicate (Int mInt -> Int -> Int forall a. Num a => a -> a -> a -Int l) String "" mkUniformBlocks :: [[String]] -> [[String]] mkUniformBlocks :: [[String]] -> [[String]] mkUniformBlocks = ([String] -> [String]) -> [[String]] -> [[String]] forall a b. (a -> b) -> [a] -> [b] map [String] -> [String] mkLinesUniformWidth ([[String]] -> [[String]]) -> ([[String]] -> [[String]]) -> [[String]] -> [[String]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[String]] -> [[String]] mkBlocksUniformHeight hConcatLines :: [[String]] -> [String] hConcatLines :: [[String]] -> [String] hConcatLines = ([String] -> String) -> [[String]] -> [String] forall a b. (a -> b) -> [a] -> [b] map [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[String]] -> [String]) -> ([[String]] -> [[String]]) -> [[String]] -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[String]] -> [[String]] forall a. [[a]] -> [[a]] transpose ([[String]] -> [[String]]) -> ([[String]] -> [[String]]) -> [[String]] -> [[String]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[String]] -> [[String]] mkUniformBlocks vConcatLines :: [[String]] -> [String] vConcatLines :: [[String]] -> [String] vConcatLines = [[String]] -> [String] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat -------------------------------------------------------------------------------- -- * counting -- helps testing the random rutines count :: Eq a => a -> [a] -> Int count :: a -> [a] -> Int count a x [a] xs = [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] filter (a -> a -> Bool forall a. Eq a => a -> a -> Bool ==a x) [a] xs histogram :: (Eq a, Ord a) => [a] -> [(a,Int)] histogram :: [a] -> [(a, Int)] histogram [a] xs = Map a Int -> [(a, Int)] forall k a. Map k a -> [(k, a)] Map.toList Map a Int table where table :: Map a Int table = (Int -> Int -> Int) -> [(a, Int)] -> Map a Int forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a Map.fromListWith Int -> Int -> Int forall a. Num a => a -> a -> a (+) [ (a x,Int 1) | a x<-[a] xs ] -------------------------------------------------------------------------------- -- * maybe fromJust :: Maybe a -> a fromJust :: Maybe a -> a fromJust (Just a x) = a x fromJust Maybe a Nothing = String -> a forall a. HasCallStack => String -> a error String "fromJust: Nothing" -------------------------------------------------------------------------------- -- * bool intToBool :: Int -> Bool intToBool :: Int -> Bool intToBool Int 0 = Bool False intToBool Int 1 = Bool True intToBool Int _ = String -> Bool forall a. HasCallStack => String -> a error String "intToBool" boolToInt :: Bool -> Int boolToInt :: Bool -> Int boolToInt Bool False = Int 0 boolToInt Bool True = Int 1 -------------------------------------------------------------------------------- -- * iteration -- iterated function application nest :: Int -> (a -> a) -> a -> a nest :: Int -> (a -> a) -> a -> a nest !Int 0 a -> a _ a x = a x nest !Int n a -> a f a x = Int -> (a -> a) -> a -> a forall a. Int -> (a -> a) -> a -> a nest (Int nInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1) a -> a f (a -> a f a x) unfold1 :: (a -> Maybe a) -> a -> [a] unfold1 :: (a -> Maybe a) -> a -> [a] unfold1 a -> Maybe a f a x = case a -> Maybe a f a x of Maybe a Nothing -> [a x] Just a y -> a x a -> [a] -> [a] forall a. a -> [a] -> [a] : (a -> Maybe a) -> a -> [a] forall a. (a -> Maybe a) -> a -> [a] unfold1 a -> Maybe a f a y unfold :: (b -> (a,Maybe b)) -> b -> [a] unfold :: (b -> (a, Maybe b)) -> b -> [a] unfold b -> (a, Maybe b) f b y = let (a x,Maybe b m) = b -> (a, Maybe b) f b y in case Maybe b m of Maybe b Nothing -> [a x] Just b y' -> a x a -> [a] -> [a] forall a. a -> [a] -> [a] : (b -> (a, Maybe b)) -> b -> [a] forall b a. (b -> (a, Maybe b)) -> b -> [a] unfold b -> (a, Maybe b) f b y' unfoldEither :: (b -> Either c (b,a)) -> b -> (c,[a]) unfoldEither :: (b -> Either c (b, a)) -> b -> (c, [a]) unfoldEither b -> Either c (b, a) f b y = case b -> Either c (b, a) f b y of Left c z -> (c z,[]) Right (b y,a x) -> let (c z,[a] xs) = (b -> Either c (b, a)) -> b -> (c, [a]) forall b c a. (b -> Either c (b, a)) -> b -> (c, [a]) unfoldEither b -> Either c (b, a) f b y in (c z,a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs) unfoldM :: Monad m => (b -> m (a,Maybe b)) -> b -> m [a] unfoldM :: (b -> m (a, Maybe b)) -> b -> m [a] unfoldM b -> m (a, Maybe b) f b y = do (a x,Maybe b m) <- b -> m (a, Maybe b) f b y case Maybe b m of Maybe b Nothing -> [a] -> m [a] forall (m :: * -> *) a. Monad m => a -> m a return [a x] Just b y' -> do [a] xs <- (b -> m (a, Maybe b)) -> b -> m [a] forall (m :: * -> *) b a. Monad m => (b -> m (a, Maybe b)) -> b -> m [a] unfoldM b -> m (a, Maybe b) f b y' [a] -> m [a] forall (m :: * -> *) a. Monad m => a -> m a return (a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs) mapAccumM :: Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y]) mapAccumM :: (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y]) mapAccumM acc -> x -> m (acc, y) _ acc s [] = (acc, [y]) -> m (acc, [y]) forall (m :: * -> *) a. Monad m => a -> m a return (acc s, []) mapAccumM acc -> x -> m (acc, y) f acc s (x x:[x] xs) = do (acc s1,y y) <- acc -> x -> m (acc, y) f acc s x x (acc s2,[y] ys) <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y]) forall (m :: * -> *) acc x y. Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y]) mapAccumM acc -> x -> m (acc, y) f acc s1 [x] xs (acc, [y]) -> m (acc, [y]) forall (m :: * -> *) a. Monad m => a -> m a return (acc s2, y yy -> [y] -> [y] forall a. a -> [a] -> [a] :[y] ys) -------------------------------------------------------------------------------- -- * long zipwith longZipWith :: a -> b -> (a -> b -> c) -> [a] -> [b] -> [c] longZipWith :: a -> b -> (a -> b -> c) -> [a] -> [b] -> [c] longZipWith a a0 b b0 a -> b -> c f = [a] -> [b] -> [c] go where go :: [a] -> [b] -> [c] go (a x:[a] xs) (b y:[b] ys) = a -> b -> c f a x b y c -> [c] -> [c] forall a. a -> [a] -> [a] : [a] -> [b] -> [c] go [a] xs [b] ys go [] [b] ys = [ a -> b -> c f a a0 b y | b y<-[b] ys ] go [a] xs [] = [ a -> b -> c f a x b b0 | a x<-[a] xs ] {- longZipWithZero :: (Num a, Num b) => (a -> b -> c) -> [a] -> [b] -> [c] longZipWithZero = longZipWith 0 0 -} -------------------------------------------------------------------------------- -- * random -- | A simple random monad to make life suck less type Rand g = RandT g Identity runRand :: Rand g a -> g -> (a,g) runRand :: Rand g a -> g -> (a, g) runRand Rand g a action g g = Identity (a, g) -> (a, g) forall a. Identity a -> a runIdentity (Rand g a -> g -> Identity (a, g) forall g (m :: * -> *) a. RandT g m a -> g -> m (a, g) runRandT Rand g a action g g) flipRunRand :: Rand s a -> s -> (s,a) flipRunRand :: Rand s a -> s -> (s, a) flipRunRand Rand s a action s g = Identity (s, a) -> (s, a) forall a. Identity a -> a runIdentity (Rand s a -> s -> Identity (s, a) forall (m :: * -> *) s a. Monad m => RandT s m a -> s -> m (s, a) flipRunRandT Rand s a action s g) -- | The Rand monad transformer newtype RandT g m a = RandT (StateT g m a) deriving (a -> RandT g m b -> RandT g m a (a -> b) -> RandT g m a -> RandT g m b (forall a b. (a -> b) -> RandT g m a -> RandT g m b) -> (forall a b. a -> RandT g m b -> RandT g m a) -> Functor (RandT g m) forall a b. a -> RandT g m b -> RandT g m a forall a b. (a -> b) -> RandT g m a -> RandT g m b forall g (m :: * -> *) a b. Functor m => a -> RandT g m b -> RandT g m a forall g (m :: * -> *) a b. Functor m => (a -> b) -> RandT g m a -> RandT g m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> RandT g m b -> RandT g m a $c<$ :: forall g (m :: * -> *) a b. Functor m => a -> RandT g m b -> RandT g m a fmap :: (a -> b) -> RandT g m a -> RandT g m b $cfmap :: forall g (m :: * -> *) a b. Functor m => (a -> b) -> RandT g m a -> RandT g m b Functor,Functor (RandT g m) a -> RandT g m a Functor (RandT g m) -> (forall a. a -> RandT g m a) -> (forall a b. RandT g m (a -> b) -> RandT g m a -> RandT g m b) -> (forall a b c. (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c) -> (forall a b. RandT g m a -> RandT g m b -> RandT g m b) -> (forall a b. RandT g m a -> RandT g m b -> RandT g m a) -> Applicative (RandT g m) RandT g m a -> RandT g m b -> RandT g m b RandT g m a -> RandT g m b -> RandT g m a RandT g m (a -> b) -> RandT g m a -> RandT g m b (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c forall a. a -> RandT g m a forall a b. RandT g m a -> RandT g m b -> RandT g m a forall a b. RandT g m a -> RandT g m b -> RandT g m b forall a b. RandT g m (a -> b) -> RandT g m a -> RandT g m b forall a b c. (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c forall g (m :: * -> *). Monad m => Functor (RandT g m) forall g (m :: * -> *) a. Monad m => a -> RandT g m a forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m a forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m b forall g (m :: * -> *) a b. Monad m => RandT g m (a -> b) -> RandT g m a -> RandT g m b forall g (m :: * -> *) a b c. Monad m => (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f <* :: RandT g m a -> RandT g m b -> RandT g m a $c<* :: forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m a *> :: RandT g m a -> RandT g m b -> RandT g m b $c*> :: forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m b liftA2 :: (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c $cliftA2 :: forall g (m :: * -> *) a b c. Monad m => (a -> b -> c) -> RandT g m a -> RandT g m b -> RandT g m c <*> :: RandT g m (a -> b) -> RandT g m a -> RandT g m b $c<*> :: forall g (m :: * -> *) a b. Monad m => RandT g m (a -> b) -> RandT g m a -> RandT g m b pure :: a -> RandT g m a $cpure :: forall g (m :: * -> *) a. Monad m => a -> RandT g m a $cp1Applicative :: forall g (m :: * -> *). Monad m => Functor (RandT g m) Applicative,Applicative (RandT g m) a -> RandT g m a Applicative (RandT g m) -> (forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b) -> (forall a b. RandT g m a -> RandT g m b -> RandT g m b) -> (forall a. a -> RandT g m a) -> Monad (RandT g m) RandT g m a -> (a -> RandT g m b) -> RandT g m b RandT g m a -> RandT g m b -> RandT g m b forall a. a -> RandT g m a forall a b. RandT g m a -> RandT g m b -> RandT g m b forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b forall g (m :: * -> *). Monad m => Applicative (RandT g m) forall g (m :: * -> *) a. Monad m => a -> RandT g m a forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m b forall g (m :: * -> *) a b. Monad m => RandT g m a -> (a -> RandT g m b) -> RandT g m b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: a -> RandT g m a $creturn :: forall g (m :: * -> *) a. Monad m => a -> RandT g m a >> :: RandT g m a -> RandT g m b -> RandT g m b $c>> :: forall g (m :: * -> *) a b. Monad m => RandT g m a -> RandT g m b -> RandT g m b >>= :: RandT g m a -> (a -> RandT g m b) -> RandT g m b $c>>= :: forall g (m :: * -> *) a b. Monad m => RandT g m a -> (a -> RandT g m b) -> RandT g m b $cp1Monad :: forall g (m :: * -> *). Monad m => Applicative (RandT g m) Monad) runRandT :: RandT g m a -> g -> m (a,g) runRandT :: RandT g m a -> g -> m (a, g) runRandT (RandT StateT g m a stuff) = StateT g m a -> g -> m (a, g) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT StateT g m a stuff -- | This may be occasionally useful flipRunRandT :: Monad m => RandT s m a -> s -> m (s,a) flipRunRandT :: RandT s m a -> s -> m (s, a) flipRunRandT RandT s m a action s ini = ((a, s) -> (s, a)) -> m (a, s) -> m (s, a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (a, s) -> (s, a) forall a b. (a, b) -> (b, a) swap (m (a, s) -> m (s, a)) -> m (a, s) -> m (s, a) forall a b. (a -> b) -> a -> b $ RandT s m a -> s -> m (a, s) forall g (m :: * -> *) a. RandT g m a -> g -> m (a, g) runRandT RandT s m a action s ini -- | Puts a standard-conforming random function into the monad rand :: (g -> (a,g)) -> Rand g a rand :: (g -> (a, g)) -> Rand g a rand g -> (a, g) user = StateT g Identity a -> Rand g a forall g (m :: * -> *) a. StateT g m a -> RandT g m a RandT ((g -> (a, g)) -> StateT g Identity a forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a state g -> (a, g) user) randRoll :: (RandomGen g, Random a) => Rand g a randRoll :: Rand g a randRoll = (g -> (a, g)) -> Rand g a forall g a. (g -> (a, g)) -> Rand g a rand g -> (a, g) forall a g. (Random a, RandomGen g) => g -> (a, g) random randChoose :: (RandomGen g, Random a) => (a,a) -> Rand g a randChoose :: (a, a) -> Rand g a randChoose (a, a) uv = (g -> (a, g)) -> Rand g a forall g a. (g -> (a, g)) -> Rand g a rand ((a, a) -> g -> (a, g) forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g) randomR (a, a) uv) randProxy1 :: Rand g (f n) -> Proxy n -> Rand g (f n) randProxy1 :: Rand g (f n) -> Proxy n -> Rand g (f n) randProxy1 Rand g (f n) action Proxy n _ = Rand g (f n) action --------------------------------------------------------------------------------