I'd like to sort by one property and then by another (if the first property is the same.)
What's the idiomatic way in Haskell of composing two comparison functions, i.e. a function used with sortBy?
Given
f :: Ord a => a -> a -> Ordering
g :: Ord a => a -> a -> Ordering
composing f and g would yield:
h x y = case v of
EQ -> g x y
otherwise -> v
where v = f x y
vitus points out the very cool instance of Monoid for Ordering. If you combine it with the instance instance Monoid b => Monoid (a -> b) it turns out your composition function is just (get ready):
mappend
Check it out:
Prelude Data.Monoid> let f a b = EQ
Prelude Data.Monoid> let g a b = LT
Prelude Data.Monoid> :t f `mappend` g
f `mappend` g :: t -> t1 -> Ordering
Prelude Data.Monoid> (f `mappend` g) undefined undefined
LT
Prelude Data.Monoid> let f a b = GT
Prelude Data.Monoid> (f `mappend` g) undefined undefined
GT
+1 for powerful and simple abstractions
You can use the <> operator. In this example bigSort sorts string by their numerical value, first comparing length and then comparing lexicographically.
import Data.List (sortBy)
import Data.Ord (compare, comparing)
bigSort :: [String] -> [String]
bigSort = sortBy $ (comparing length) <> compare
Example:
bigSort ["31415926535897932384626433832795","1","3","10","3","5"] =
["1","3","3","5","10","31415926535897932384626433832795"]
<> is an alias of mappend from the Data.Monoid module (see jberryman answer).
The (free) book Learn You a Haskell for Great Good! explains how it works here in Chapter 11
instance Monoid Ordering where
mempty = EQ
LT `mappend` _ = LT
EQ `mappend` y = y
GT `mappend` _ = GT
The instance is set up like this: when we mappend two Ordering values, the one on the left is kept, unless the value on the left is EQ, in which case the right one is the result. The identity is EQ.
Related
I have a list of tuples and I would like to sort it by second element (descending) and then by first element (ascending).
My code looks like this:
sortedOcc :: Eq a => [a] -> [(a, Int)]
sortedOcc = sortBy (flip compare `on` snd) . occurences
and this is the first sorting by the second element of list returned by occurences (function). How should I add the second sort (ascending) by the first element?
The Data.Ord module provides a Down newtype whose purpose is solely to reverse the ordering.
It also provides a comparing function:
comparing :: Ord a => (b -> a) -> b -> b -> Ordering
which must be fed some transformation function before it can be passed to sortBy.
Like this:
$ ghci
GHCi, version 8.8.4: https://www.haskell.org/ghc/ :? for help
λ>
λ> sortBy (comparing (\(a,v) -> (Down v, a))) [(1,2),(1,3),(5,2),(5,3)]
[(1,3),(5,3),(1,2),(5,2)]
λ>
The values returned by the transformation function are then sorted using their own “natural” order. In our case, this is the lexicographic order on pairs of ordered types.
Overall, the code would require an Ord a constraint:
sortedOcc :: Ord a => [a] -> [(a, Int)]
sortedOcc = sortBy (comparing (\(a,v) -> (Down v, a))) . occurences
I'd probably write this using the Monoid instance on Ordering and on function types.
Sorting on the second value in the tuple looks like flip compare `on` snd, as you've already determined, while sorting on the first value looks like compare `on` fst.
These can be combined Monoidally with <>.
d :: [(String , Int)]
d = [("b", 1), ("a", 1), ("c",3), ("d",4)]
sortedD = sortBy ((flip compare `on` snd) <> (compare `on` fst)) d
I know that the rest of the answers are shorter, but I recommend you to implement these lazy functions yourself before using the already Haskell implemented ones, so you understand how it works.
-- Order a list of tuples by the first item
orderBy1stTupleItem :: Ord a => (a, b1) -> (a, b2) -> Ordering
orderBy1stTupleItem tup1 tup2
| item1 > item2 = GT
| item1 < item2 = LT
| otherwise = EQ
where
item1 = fst tup1
item2 = fst tup2
-- Order a list of tuples by the second item
orderBy2ndTupleItem :: Ord a1 => (a2, a1) -> (a3, a1) -> Ordering
orderBy2ndTupleItem tup1 tup2
| item1 > item2 = GT
| item1 < item2 = LT
| otherwise = EQ
where
item1 = snd tup1
item2 = snd tup2
-- Wrapper Function: Order a list of tuples by the first item and later by the second item
orderTuplesBy1stThenBy2ndItem :: (Ord a1, Ord a2) => [(a2, a1)] -> [(a2, a1)]
orderTuplesBy1stThenBy2ndItem listTuples =
sortBy orderBy2ndTupleItem (sortBy orderBy1stTupleItem listTuples)
Example
let exampleListTuples = [(1,2),(0,8),(6,1),(3,6),(9,1),(7,8),(0,9)]
Then let's get the 1st list, ordered by the first item of each tuple:
> listOrderedByTuple1stItem = sortBy orderBy1stTupleItem exampleListTuples
> listOrderedByTuple1stItem
[(0,8),(0,9),(1,2),(3,6),(6,1),(7,8),(9,1)]
Now we order this result list by the second item of each tuple
> sortBy orderBy2ndTupleItem listOrderedByTuple1stItem
[(6,1),(9,1),(1,2),(3,6),(0,8),(7,8),(0,9)]
Or, you can just run the wrapper function orderTuplesBy1stThenBy2ndItem as follows:
> sortBy orderTuplesBy1stThenBy2ndItem exampleListTuples
What is sortBy's signature?
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
This means that its first argument must have the type a -> a -> Ordering:
sortedOcc :: Eq a => [a] -> [(a, Int)]
sortedOcc = sortBy g . occurences
g :: a -> a -> Ordering
g = (flip compare `on` snd)
but that means that
g :: a -> a -> Ordering
g x y = (flip compare `on` snd) x y
= flip compare (snd x) (snd y)
= compare (snd y) (snd x)
and so to add your requirement into the mix we simply have to write it down,
= let test1 = compare (snd y) (snd x)
test2 = compare (snd y) (snd x)
in ......
right?
The above intentionally contains errors, which should be straightforward for you to fix.
A word of advice, only use point-free code if it is easy and natural for you to read and write, and modify.
Im trying to understand function composition in Haskell.
According to ZVON http://zvon.org/other/haskell/Outputprelude/filter_f.html
the filter function should have two arguments, a bool function and a list.
Example filter (>5) [1,2,3,4,5,6,7,8] returns anything greater than 5:
[6,7,8]
Question, how does the following line with several function compositions pass in a boolean for the filter to utilize?
map fst . filter snd . assocs . soeA
shouldn't it be map fst . filter (==True) snd . assocs . soeA
To analyze I run the first two functions of the composition and pass an argument: assocs . soeA $ 9 returns
[(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False)]
soe 9 returns [2,3,5,7]
Somehow the bool value in each array element of soeA is being used, but any help explaining how this composition is working would be very much appreciated.
Full Code is:
`
module FastSeive where
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
soeST :: forall s. Int -> ST s (STUArray s Int Bool)
soeST n = do
arr <- newArray (0, n) True
mapM_ (\i -> writeArray arr i False) [0, 1]
let n2 = n `div` 2
let loop :: Int -> ST s ()
loop i | i > n2 = return ()
loop i = do
b <- readArray arr i
let reset :: Int -> ST s ()
reset j | j > n = return ()
reset j = writeArray arr j False >> reset (j + i)
when b (reset (2*i))
loop (succ i)
loop 2
return arr
soeA :: Int -> UArray Int Bool
soeA n = runST (soeST n >>= freeze)
soe :: Int -> [Int]
soe = map fst . filter snd . assocs . soeA
soeCount :: Int -> Int
soeCount = length . filter id . elems . soeA
`
The short answer is: here, snd is the Bool-returning function filter expects. In the expression you wrote: map fst . filter (==True) snd . assocs . soeA. snd would be filter's second argument, while (==True) would be the first one. Of course, it won't typecheck because filter is already applied to two arguments, and cannot be used in function composition: it's not a function anymore.
For a longer answer, we can actually apply (.)'s definition to find out what's happening:
(f . g) x = f (g x)
-- In haskell, it is defined as being right associative
-- Meaning that if we put explicit parenthesises, we'd have:
soe = (map fst . (filter snd . (assocs . soeA)))
-- That only really matters for the compiler, though,
-- because we know function composition is associative.
soe = map fst . filter snd . assocs . soeA
-- "Un-pointfree-ing" it:
soe x = (map fst . filter snd . assocs . soeA) x
-- Applying (.)'s definition:
soe x = map fst ((filter snd . assocs . soeA) x)
-- Again:
soe x = map fst (filter snd ((assocs . soeA) x))
-- And again:
soe x = map fst (filter snd (asocs (soeA x)))
It's now clear that snd is filter's first argument, while the second argument will evaluate to what assocs (soeA x) will evaluate to.
More generally, when one writes f . g . h, this can be read right-to-left as a function that first applies h to its argument, then g to the result, then f to the next result, and yields that final value.
Now, for the even longer answer, we can look at how the types for your expression will be inferred. It'll tell us why snd is the Bool-returning function filter expects even though it has a type signature of snd :: (a, b) -> b.
Disclaimer: I don't have a background in compiler engineering; the terms I'll be using may be inexact.
The type of filter is (a -> Bool) -> [a] -> [a]. The type of snd is (a, b) -> b.
Those are actually parameterized types. We can make the type parameters explicit:
filter :: forall a. (a -> Bool) -> [a] -> [a]
snd :: forall a b. (a, b) -> b
We'll also rename filter's type argument in order to make it non-ambiguous in what we'll write next:
filter :: forall c. (c -> Bool) -> [c] -> [c]
filter gets applied first to snd. So, we can try and unify c -> Bool from filter with (a, b) -> b, snd's type. We get these equations :
c -> Bool = (a, b) -> b
===
c = (a, b)
b = Bool
===
c = (a, Bool)
b = Bool
We'll assume that assocs (soeA x)'s type is [(Int, Bool)]. Since filter's second argument has the type [c], we can unify further:
[c] = [(Int, Bool)]
===
c = (Int, Bool)
This also gives us:
(Int, Bool) = c = (a, Bool)
===
a = Int
So, after type application, we get these concrete types for our sub-expressions :
filter :: ((Int, Bool) -> Bool) -> [(Int, Bool)] -> [(Int, Bool)]
snd :: (Int, Bool) -> Bool
Well, of course, we could have used GHC's type inference all along to tell us about that, either using GHCi, or through a text editor's haskell plugin.
Some time ago, I've asked how to map back and forth from godel numbers to terms of a context-free language. While the answer solved the issue specificaly, I'm having trouble in actually programming it generically. So, this question is more generic: given a recursive algebraic data type with terminals, sums and products - such as
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
what is an algorithm that will map a term of this type to its godel number, and its inverse?
Edit: for example:
data Foo = A | B Foo | C Foo deriving Show
to :: Foo -> Int
to A = 1
to (B x) = to x * 2
to (C x) = to x * 2 + 1
from :: Int -> Foo
from 1 = A
from n = case mod n 2 of
0 -> B (from (div n 2))
1 -> C (from (div n 2))
Here, to and from do what I want for Foo. I'm just asking for a systematic way to derive those functions for any datatype.
In order to avoid dealing with a particular Goedel numbering, let's define a class that'll abstract the necessary operations (with some imports we'll need later):
{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleContexts, DeriveGeneric #-}
import Control.Applicative
import GHC.Generics
import Test.QuickCheck
import Test.QuickCheck.Gen
class GodelNum a where
fromInt :: Integer -> a
toInt :: a -> Maybe Integer
encode :: [a] -> a
decode :: a -> [a]
So we can inject natural numbers and encode sequences. Let's further create a canonical instance of this class that'll use throughout the code, which does no real Goedel encoding, just constructs a tree of terms.
data TermNum = Value Integer | Complex [TermNum]
deriving (Show)
instance GodelNum TermNum where
fromInt = Value
toInt (Value x) = Just x
toInt _ = Nothing
encode = Complex
decode (Complex xs) = xs
decode _ = []
For real encoding we'd use another implementation that'd use just one Integer, something like newtype SomeGoedelNumbering = SGN Integer.
Let's further create a class for types that we can encode/decode:
class GNum a where
gto :: (GodelNum g) => a -> g
gfrom :: (GodelNum g) => g -> Maybe a
default gto :: (Generic a, GodelNum g, GGNum (Rep a)) => a -> g
gto = ggto . from
default gfrom :: (Generic a, GodelNum g, GGNum (Rep a)) => g -> Maybe a
gfrom = liftA to . ggfrom
The last four lines define a generic implementation of gto and gfrom using GHC Generics and DefaultSignatures. The class GGNum that they use is a helper class which we'll use to define encoding for the atomic ADT operations - products, sums, etc.:
class GGNum f where
ggto :: (GodelNum g) => f a -> g
ggfrom :: (GodelNum g) => g -> Maybe (f a)
-- no-arg constructors
instance GGNum U1 where
ggto U1 = encode []
ggfrom _ = Just U1
-- products
instance (GGNum a, GGNum b) => GGNum (a :*: b) where
ggto (a :*: b) = encode [ggto a, ggto b]
ggfrom e | [x, y] <- decode e = liftA2 (:*:) (ggfrom x) (ggfrom y)
| otherwise = Nothing
-- sums
instance (GGNum a, GGNum b) => GGNum (a :+: b) where
ggto (L1 x) = encode [fromInt 0, ggto x]
ggto (R1 y) = encode [fromInt 1, ggto y]
ggfrom e | [n, x] <- decode e = case toInt n of
Just 0 -> L1 <$> ggfrom x
Just 1 -> R1 <$> ggfrom x
_ -> Nothing
-- metadata
instance (GGNum a) => GGNum (M1 i c a) where
ggto (M1 x) = ggto x
ggfrom e = M1 <$> ggfrom e
-- constants and recursion of kind *
instance (GNum a) => GGNum (K1 i a) where
ggto (K1 x) = gto x
ggfrom e = K1 <$> gfrom e
Having that, we can then define a data type like yours and just declare its GNum instance, everything else will be automatically derived.
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
deriving (Eq, Show, Generic)
instance GNum Term where
And just to be sure we've done everything right, let's use QuickCheck to verify that our gfrom is an inverse of gto:
instance Arbitrary Term where
arbitrary = oneof [ return AtomA
, return AtomB
, SumL <$> arbitrary
, SumR <$> arbitrary
, Prod <$> arbitrary <*> arbitrary
]
prop_enc_dec :: Term -> Property
prop_enc_dec x = Just x === gfrom (gto x :: TermNum)
main :: IO ()
main = quickCheck prop_enc_dec
Notes:
The same thing could be accomplished using Scrap Your Boilerplate, perhaps more efficiently, as it allows somewhat higher-level access - enumerating constructors and records, etc.
See also paper Efficient Bijective G¨odel Numberings for Term Algebras (I haven't read the paper yet, but seems related).
For fun, I decided to try the approach in the link you posted, and didn't get stuck anywhere. So here's my code, with no commentary (the explanation is the same as the last time). First, code stolen from the other answer:
{-# LANGUAGE TypeSynonymInstances #-}
import Control.Applicative
import Data.Universe.Helpers
type Nat = Integer
class Godel a where
to :: a -> Nat
from :: Nat -> a
instance Godel Nat where to = id; from = id
instance (Godel a, Godel b) => Godel (a, b) where
to (m_, n_) = (m + n) * (m + n + 1) `quot` 2 + m where
m = to m_
n = to n_
from p = (from m, from n) where
isqrt = floor . sqrt . fromIntegral
base = (isqrt (1 + 8 * p) - 1) `quot` 2
triangle = base * (base + 1) `quot` 2
m = p - triangle
n = base - m
And the code specific to your new type:
data Term = Prod Term Term | SumL Term | SumR Term | AtomA | AtomB
deriving (Eq, Ord, Read, Show)
ts = AtomA : AtomB : interleave [uncurry Prod <$> ts +*+ ts, SumL <$> ts, SumR <$> ts]
instance Godel Term where
to AtomA = 0
to AtomB = 1
to (Prod t1 t2) = 2 + 0 + 3 * to (t1, t2)
to (SumL t) = 2 + 1 + 3 * to t
to (SumR t) = 2 + 2 + 3 * to t
from 0 = AtomA
from 1 = AtomB
from n = case quotRem (n-2) 3 of
(q, 0) -> uncurry Prod (from q)
(q, 1) -> SumL (from q)
(q, 2) -> SumR (from q)
The same ghci test as last time:
*Main> take 30 (map from [0..]) == take 30 ts
True
Here's a simple function that takes a list and a number and works out if the length of the list is greater than that number.
e.g.
compareLengthTo [1,2,3] 3 == EQ
compareLengthTo [1,2] 3 == LT
compareLengthTo [1,2,3,4] 3 == GT
compareLengthTo [1..] 3 == GT
Note that it has two properties:
It works for infinite lists.
It is tail recursive and uses constant space.
import Data.Ord
compareLengthTo :: [a] -> Int -> Ordering
compareLengthTo l n = f 0 l
where
f c [] = c `compare` n
f c (l:ls) | c > n = GT
| otherwise = f (c + 1) ls
Is there a way to write compareLengthTo using foldr only?
Note, here's a version of compareLengthTo using drop:
compareLengthToDrop :: [a] -> Int -> Ordering
compareLengthToDrop l n = f (drop n (undefined:l))
where
f [] = LT
f [_] = EQ
f _ = GT
I guess another question is then, can you implement drop in terms of foldr?
Here ya go (note: I just changed one comparison, which makes it lazier):
compareLengthTo :: [a] -> Int -> Ordering
compareLengthTo l n = foldr f (`compare` n) l 0
where
f l cont c | c >= n = GT
| otherwise = cont $! c + 1
This uses exactly the same sort of technique used to implement foldl in terms of foldr. There's a classic article about the general technique called A tutorial on the universality and expressiveness of fold. You can also see a step-by-step explanation I wrote on the Haskell Wiki.
To get you started, note that foldr is being applied to four arguments here, rather than the usual three. This works out because the function being folded takes three arguments, and the "base case" is a function, (`compare` n).
Edit
If you want to use lazy Peano numerals as J. Abrahamson does, you can count down instead of counting up.
compareLengthTo :: [a] -> Nat -> Ordering
compareLengthTo l n = foldr f final l n
where
f _ _ Zero = GT
f _ cont (Succ p) = cont p
final Zero = EQ
final _ = LT
By it's very definition, foldr is not tail-recursive:
-- slightly simplified
foldr :: (a -> r -> r) -> r -> ([a] -> r)
foldr cons nil [] = nil
foldr cons nil (a:as) = cons a (foldr cons nil as)
so you cannot achieve that end. That said, there are some attractive components of foldr's semantics. In particular, it is "productive" which allows folds written with foldr to behave nicely with laziness.
We can see foldr as saying how to break down (catalyze) a list one "layer" at a time. If the cons argument can return without caring about any further layers of the list then it can terminate early and we avoid ever having to examine any more tails of the list---this is how foldr can act non-strictly at times.
Your function, to work on infinite lists, does something similar to the numeric argument. We'd like to operate on that argument "layer by layer". To make this more clear, let's define the naturals as follows
data Nat = Zero | Succ Nat
Now "layer by layer" more clearly means "counting down to zero". We can formalize that notion like so:
foldNat :: (r -> r) -> r -> (Nat -> r)
foldNat succ zero Zero = zero
foldNat succ zero (Succ n) = succ (foldNat succ zero n)
and now we can define something a bit like what we're looking for
compareLengthTo :: Nat -> [a] -> Ordering
compareLengthTo = foldNat succ zero where
zero :: [a] -> Ordering
zero [] = EQ -- we emptied the list and the nat at the same time
zero _ = GT -- we're done with the nat, but more list remains
succ :: ([a] -> Ordering) -> ([a] -> Ordering)
succ continue [] = LT -- we ran out of list, but had more nat
succ continue (_:as) = continue as -- keep going, both nat and list remain
It can take some time to study the above to see how it works. In particular, note that I instantiated r as a function, [a] -> Ordering. The form of the function above is "recursion on the natural numbers" and it allows it to accept infinite lists so long as the Nat argument isn't...
infinity :: Nat
infinity = Succ infinity
Now, the above function works on this strange type, Nat, which models the non-negative integers. We can translate the same concept to Int by replacing foldNat with foldInt, written similarly:
foldInt :: (r -> r) -> r -> (Int -> r)
foldInt succ zero 0 = zero
foldInt succ zero n = succ (foldInt succ zero (n - 1))
which you can verify embodies the exact same pattern as foldNat but avoids the use of the awkward Succ and Zero constructors. You can also verify that foldInt behaves pathologically if we give it negative integers... which is about what we'd expect.
Have to participate into this coding competion:
"Prelude":
import Test.QuickCheck
import Control.Applicative
compareLengthTo :: [a] -> Int -> Ordering
compareLengthTo l n = f 0 l
where
f c [] = c `compare` n
f c (l:ls) | c > n = GT
| otherwise = f (c + 1) ls
My first attempt was to write this
compareLengthTo1 :: [a] -> Int -> Ordering
compareLengthTo1 l n = g $ foldr f (Just n) l
where
-- we go below zero
f _ (Just 0) = Nothing
f _ (Just n) = Just (n - 1)
f _ Nothing = Nothing
g (Just 0) = EQ
g (Just _) = LT
g Nothing = GT
And it works for finite arguments:
prop1 :: [()] -> NonNegative Int -> Property
prop1 l (NonNegative n) = compareLengthTo l n === compareLengthTo1 l n
-- >>> quickCheck prop1
-- +++ OK, passed 100 tests.
But it fails for infinite lists. Why?
Let's define a variant using peano naturals:
data Nat = Zero | Succ Nat
foldNat :: (r -> r) -> r -> (Nat -> r)
foldNat succ zero Zero = zero
foldNat succ zero (Succ n) = succ (foldNat succ zero n)
natFromInteger :: Integer -> Nat
natFromInteger 0 = Zero
natFromInteger n = Succ (natFromInteger (n - 1))
natToIntegral :: Integral a => Nat -> a
natToIntegral = foldNat (1+) 0
instance Arbitrary Nat where
arbitrary = natFromInteger . getNonNegative <$> arbitrary
instance Show Nat where
show = show . (natToIntegral :: Nat -> Integer)
infinity :: Nat
infinity = Succ infinity
compareLengthTo2 :: [a] -> Nat -> Ordering
compareLengthTo2 l n = g $ foldr f (Just n) l
where
f _ (Just Zero) = Nothing
f _ (Just (Succ n)) = Just n
f _ Nothing = Nothing
g (Just Zero) = EQ
g (Just _) = LT
g Nothing = GT
prop2 :: [()] -> Nat -> Property
prop2 l n = compareLengthTo l (natToIntegral n) === compareLengthTo2 l n
-- >>> compareLengthTo2 [] infinity
-- LT
After staring long enough we see that it works for infinite numbers, not infinite lists.
That's why J. Abrahamson used foldNat in his definition.
So if we fold the number argument, we will get function which works on infinite lists, but finite numbers:
compareLengthTo3 :: [a] -> Nat -> Ordering
compareLengthTo3 l n = g $ foldNat f (Just l) n
where
f (Just []) = Nothing
f (Just (x:xs)) = Just xs
f Nothing = Nothing
g (Just []) = EQ
g (Just _) = GT
g Nothing = LT
prop3 :: [()] -> Nat -> Property
prop3 l n = compareLengthTo l (natToIntegral n) === compareLengthTo3 l n
nats :: [Nat]
nats = iterate Succ Zero
-- >>> compareLengthTo3 nats (natFromInteger 10)
-- GT
foldr and foldNat are kind of functions which generalise structural recursion on the argument (catamorphisms). They have nice property that given finite inputs and total functions as arguments, they are also total i.e. always terminate.
That's why we foldNat in the last example. We assume that Nat argument is finite, so compareLengthTo3 works on all [a] - even infinite.
I was tried to write one random number generator implementation, based on number class. I also add there Monad and MonadPlus instance.
What mean "MonadPlus" and why I add this instance? Because of I want to use guards like here:
-- test.hs --
import RandomMonad
import Control.Monad
import System.Random
x = Rand (randomR (1 ::Integer, 3)) ::Rand StdGen Integer
y = do
a <-x
guard (a /=2)
guard (a /=1)
return a
here comes RandomMonad.hs file contents:
-- RandomMonad.hs --
module RandomMonad where
import Control.Monad
import System.Random
import Data.List
data RandomGen g => Rand g a = Rand (g ->(a,g)) | RandZero
instance (Show g, RandomGen g) => Monad (Rand g)
where
return x = Rand (\g ->(x,g))
(RandZero)>>= _ = RandZero
(Rand argTransformer)>>=(parametricRandom) = Rand funTransformer
where
funTransformer g | isZero x = funTransformer g1
| otherwise = (getRandom x g1,getGen x g1)
where
x = parametricRandom val
(val,g1) = argTransformer g
isZero RandZero = True
isZero _ = False
instance (Show g, RandomGen g) => MonadPlus (Rand g)
where
mzero = RandZero
RandZero `mplus` x = x
x `mplus` RandZero = x
x `mplus` y = x
getRandom :: RandomGen g => Rand g a ->g ->a
getRandom (Rand f) g = (fst (f g))
getGen :: RandomGen g => Rand g a ->g -> g
getGen (Rand f) g = snd (f g)
when I run ghci interpreter, and give following command
getRandom y (mkStdGen 2000000000)
I can see memory overflow on my computer (1G). It's not expected, and if I delete one guard, it works very fast. Why in this case it works too slow?
What I do wrong?
Your definition of (>>=) is certainly wrong, but I cannot point to where because it is so complicated! Instead I will explain why it cannot be defined correctly using an example. Consider:
Rand (\g -> (42,g)) >>= const mzero
We need to get that 42 out, so we need a g. The place to get the g is from the return value of the bind, so the answer is definitely:
Rand (\g -> ...)
For some ..., responsible for returning a (b,g) pair. Now that we have 42, we can evaluate const mzero 42 and find that we have RandZero But where are we going to get that b? It is nowhere (in fact, so nowhere in this example that it can be any type whatsoever, since the type of the expression is forall b. Rand b).
What is the purpose of RandZero for your monad? Are you just trying to make StateT g Maybe? My guess is that you are. In that case, you might have more luck trying to implement this type:
newtype Rand g a = Rand (g -> Maybe (a, g))
If I understand your "monad" correctly, (>>=) fails to be associative. Try defining
y' = do a <- do a' <- x
guard (a' /= 2)
return a'
guard (a /= 1)
return a
to check whether this is the case. Effectively, your backtracking strategy can only undo the last step, not the entire computation.