Combining State and List Monads - haskell

Consider the following Haskell code:
import Control.Monad.State
test :: Int -> [(Int, Int)]
test = runStateT $ do
a <- lift [1..10]
modify (+a)
return a
main = print . test $ 10
This produces the following output:
[(1,11),(2,12),(3,13),(4,14),(5,15),(6,16),(7,17),(8,18),(9,19),(10,20)]
However I would like to produce the following output instead:
[(1,11),(2,13),(3,16),(4,20),(5,25),(6,31),(7,38),(8,46),(9,55),(10,65)]
This is easy to do in an impure language like JavaScript:
function test(state) {
var result = [];
for (var a = 1; a <= 10; a++) {
result.push([a, state += a]);
}
return result;
}
How do you do the same thing in Haskell?

The Haskell types and the logic of your JavaScript code doesn't match: the JS code has two values in the state (the Int, and the returned list). In contrast, StateT Int [] a doesn't really have a list in the state; rather, it runs stateful actions multiple times (with the initial state unchanged for each run) and collects all the results in a list.
In other words, the JS code has type State (Int, [(Int, Int)]) [(Int, Int)]. But this is too literal a translation and we can write more elegant Haskell code.
Sticking to the State monad, we can return a list with mapM or forM:
test2 :: Int -> [(Int, Int)]
test2 = evalState $
forM [1..10] $ \a -> do
s <- get <* modify (+a)
return (a, s)
Some lens magic can make it more similar to the JS code:
{-# LANGUAGE TupleSections #-}
import Control.Lens
test3 :: Int -> [(Int, Int)]
test3 = evalState $
forM [1..10] $ \a -> (a,) <$> (id <+= a)
However, we can do away with State altogether, and it's the best approach here, I think:
import Control.Monad (ap)
test4 :: Int -> [(Int, Int)]
test4 n = ap zip (tail . scanl (+) n) [1..10]
-- or without ap : zip [1..10] (drop 1 $ scanl (+) n [1..10])

Your series is quadratic and can be generated more simply:
series = fmap (\x -> (x, quot (x*x + x) 2 + 10)) [1..]
If you want a recurrence relation you might write it as this:
series :: [(Int,Int)]
series = let
series' x y = (x, x + y) : series' (x + 1) (x + y)
in series' 1 10
There is no compelling reason that I see to use monads.

Related

Could I make this Haskell more idiomatic?

I'm working on the HackerRank problem sets. The following Haskell correctly solves the problem, but I have a hunch that it's not what a seasoned veteran would write. I'd appreciate any input on how to make this prettier/more expressive.
compTrips :: [Int] -> [Int] -> [Int]
compTrips as bs =
let oneIfGreater a b = if a > b
then 1
else 0
countGreater x y = foldr (+) 0 $ zipWith oneIfGreater x y
in [countGreater as bs, countGreater bs as]
main = do
line1 <- getLine
line2 <- getLine
let alice = map read $ words line1
let bob = map read $ words line2
let (a:b:_) = compTrips alice bob
putStrLn $ show a ++ " " ++ show b
I don't like compTrips's type; it's too permissive. Declaring that it can return an [Int] says you don't know how many Ints it will return. But you know it will be exactly two; so:
compTrips :: [Int] -> [Int] -> (Int, Int)
In the implementation, I'd prefer sum to foldr (+) 0; it says more clearly what you intend, and also, as a side benefit, sum uses a strict left fold and so sometimes can be more memory-efficient:
compTrips as bs =
let oneIfGreater a b = if a > b
then 1
else 0
countGreater x y = sum $ zipWith oneIfGreater x y
in (countGreater as bs, countGreater bs as)
I don't like that we compute each comparison twice. I'd want to split out the computation of the comparison from the counting up of which way the comparison went. At the same time, I would switch over from using sum and your custom fromEnum implementation (namely, oneIfGreater) to using a combination of length and filter (or, in this case where we want both "sides" of the filter, partition). So:
import Data.Bifunctor
import Data.List
compTrips as bs = bimap length length . partition id $ zipWith (>) as bs
I think you can abstract the reading and parsing of a line so that this logic is not replicated. So:
readInts :: IO [Int]
readInts = do
line <- getLine
pure (map read $ words line)
main = do
alice <- readInts
bob <- readInts
let (a, b) = compTrips alice bob
putStrLn $ show a ++ " " ++ show b
I don't like read's type, for almost exactly the same reason I don't like compTrips's type. In this case, declaring that it can accept any String says it can parse anything, when in reality it can only parse a very specific language. readMaybe has a better type, saying that it may sometimes fail to parse:
readMaybe :: Read a => String -> Maybe a
There's a large collection of Applicative-based methods for combining the error-handling of many calls to readMaybe; especially check out traverse (which is a bit like map, but with the capability to handle errors) and liftA2 (which can convert any binary operation into one that can handle errors).
One way we could use it would be to print a nice error message when it failed, so:
import System.IO
import Text.Read
readInts = do
line <- getLine
case traverse readMaybe (words line) of
Just person -> pure person
Nothing -> do
hPutStrLn stderr "That doesn't look like a space-separated collection of numbers! Try again."
readInts
(Other error-handling options exist.)
That leaves us with the following final program:
import Data.Bifunctor
import Data.List
import System.IO
import Text.Read
compTrips :: [Int] -> [Int] -> (Int, Int)
compTrips as bs = bimap length length . partition id $ zipWith (>) as bs
readInts :: IO [Int]
readInts = do
line <- getLine
case traverse readMaybe (words line) of
Just person -> pure person
Nothing -> do
hPutStrLn stderr "That doesn't look like a space-separated collection of numbers! Try again."
readInts
main :: IO ()
main = do
alice <- readInts
bob <- readInts
let (a, b) = compTrips alice bob
putStrLn $ show a ++ " " ++ show b
Although the text is actually a bit longer, I would consider this a more idiomatic implementation; the main two things being to pay careful attention to avoiding the use of partial functions (like read and your partial pattern match on the result of compTrips) and increasing the reliance on library-provided bulk operations when handling lists (like our use of length and partition).
You can obain the number of elements that match with length . filter. So you can here count the number of matches with:
compTrips :: [Int] -> [Int] -> (Int, Int)
compTrips as bs = (f as bs, f bs as)
where f xs = length . filter id . zipWith (>) xs
It is usually better to return tuples to return "multiple" values. Since then these two values can have a different type, and furthermore the type checking mechansim will guarantee that you return two items.
You can perform fmap :: Functor f => (a -> b) -> f a -> f b or its operator synonym (<$>) :: Functor f => (a -> b) -> f a -> f b on the results of getLine to "post-process" the result:
main :: IO ()
main = do
line1 <- map read . words <$> getLine
line2 <- map read . words <$> getLine
let (a, b) = compTrips line1 line2
putStrLn (show a ++ " " ++ show b)
You may perhaps do like
λ> :{
λ| getLine >>= return . map (read :: String -> Int) . words
λ| >>= \l1 -> getLine
λ| >>= return . map (read :: String -> Int) . words
λ| >>= \l2 -> return $ zipWith (\a b -> if a > b then 1 else 0) l1 l2
λ| :}
1 2 3 4 5
2 3 1 4 2
[0,0,1,0,1]

Nondeterminism for infinite inputs

Using lists to model nondeterminism is problematic if the inputs can take infinitely many values. For example
pairs = [ (a,b) | a <- [0..], b <- [0..] ]
This will return [(0,1),(0,2),(0,3),...] and never get around to showing you any pair whose first element is not 0.
Using the Cantor pairing function to collapse a list of lists into a single list can get around this problem. For example, we can define a bind-like operator that orders its outputs more intelligently by
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor (map f as)
cantor :: [[a]] -> [a]
cantor xs = go 1 xs
where
go _ [] = []
go n xs = hs ++ go (n+1) ts
where
ys = filter (not.null) xs
hs = take n $ map head ys
ts = mapN n tail ys
mapN :: Int -> (a -> a) -> [a] -> [a]
mapN _ _ [] = []
mapN n f xs#(h:t)
| n <= 0 = xs
| otherwise = f h : mapN (n-1) f t
If we now wrap this up as a monad, we can enumerate all possible pairs
newtype Select a = Select { runSelect :: [a] }
instance Monad Select where
return a = Select [a]
Select as >>= f = Select $ as >>>= (runSelect . f)
pairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a,b)
This results in
>> take 15 pairs
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4),(1,3),(2,2),(3,1),(4,0)]
which is a much more desirable result. However, if we were to ask for triples instead, the ordering on the outputs isn't as "nice" and it's not even clear to me that all outputs are eventually included --
>> take 15 triples
[(0,0,0),(0,0,1),(1,0,0),(0,1,0),(1,0,1),(2,0,0),(0,0,2),(1,1,0),(2,0,1),(3,0,0),(0,1,1),(1,0,2),(2,1,0),(3,0,1),(4,0,0)]
Note that (2,0,1) appears before (0,1,1) in the ordering -- my intuition says that a good solution to this problem will order the outputs according to some notion of "size", which could be an explicit input to the algorithm, or could be given implicitly (as in this example, where the "size" of an input is its position in the input lists). When combining inputs, the "size" of a combination should be some function (probably the sum) of the size of the inputs.
Is there an elegant solution to this problem that I am missing?
TL;DR: It flattens two dimensions at a time, rather than flattening three at once. You can't tidy this up in the monad because >>= is binary, not ternary etc.
I'll assume you defined
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor $ map f as
to interleave the list of lists.
You like that because it goes diagonally:
sums = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a+b)
gives
ghci> take 36 sums
[0,1,1,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7]
so it's pleasingly keeping the "sizes" in order, but the pattern appears to be broken for triples, and you doubt completeness, but you needn't. It's doing the same trick, but twice, rather than for all three at once:
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
The second pair is treated as a single source of data, so notice that:
ghci> map fst $ take 36 pairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map fst $ take 36 triplePairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
and (adding some spaces/newlines for clarity of pattern):
ghci> map snd $ take 36 pairs
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0]
ghci> map snd $ take 36 triplePairs
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0),
(1,1),(0,2),(1,0),(0,1),(0,0),
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)]
so you can see it's using exactly the same pattern. This doesn't preserve total sums and it oughtn't because we're getting to three dimensions by flattening two dimensions first before flattening the third in. The pattern is obscured, but it's just as guaranteed to make it to the end of the list.
Sadly if you want to do three dimensions in a sum-preserving way, you'll have to write cantor2, cantor3 and cantor4 functions, possibly a cantorN function, but you'll have to ditch the monadic interface, which is inherently based on the bracketing of >>=, hence two-at-a-time flattening of dimensions.
import Control.Applicative
import Control.Arrow
data Select a = Select [a]
| Selects [Select a]
instance Functor Select where
fmap f (Select x) = Select $ map f x
fmap f (Selects xss) = Selects $ map (fmap f) xss
instance Applicative Select where
pure = Select . (:[])
Select fs <*> xs = Selects $ map (`fmap`xs) fs
Selects fs <*> xs = Selects $ map (<*>xs) fs
instance Monad Select where
return = pure
Select xs >>= f = Selects $ map f xs
Selects xs >>= f = Selects $ map (>>=f) xs
runSelect :: Select a -> [a]
runSelect = go 1
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs
splitOff n (Select xs) = second Select $ splitAt n xs
splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl)
where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; return (a,b) }
[(0,0),(0,1),(1,0),(1,1),(0,2),(1,2),(2,0),(2,1),(2,2),(0,3),(1,3),(2,3),(3,0),(3,1),(3,2)]
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; c<‌-Select [0..]; return (a,b,c) }
[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1),(0,0,2),(0,1,2),(0,2,0),(0,2,1),(0,2,2),(1,0,2),(1,1,2)]
Note that this is still not quite Cantor-tuples ((0,1,1) shouldn't come before (1,0,0)), but getting it correct would be possible as well in a similar manner.
A correct multidimentional enumerator could be represented with a temporary state object
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
Here an N dimensional space is represented by a tuple of lists of N-1 dimensional subspaces that have and haven't been touched by the enumeration.
You can then use the following to produce a well ordered list
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
Example in Ideone.
The omega package does exactly what you want and guarantees that every element will be eventually visited:
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
Another option would be to use LogicT. It gives more flexibility (if you need) and has operations such as (>>-) that ensure that every combination is eventually encountered.
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
-- | Convert a list into any MonadPlus.
each :: (MonadPlus m) => [a] -> m a
each = msum . map return
-- | A fair variant of '(<*>)` that ensures that both branches are explored.
(<#>) :: (MonadLogic m) => m (a -> b) -> m a -> m b
(<#>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k'))
infixl 4 <#>
main = print . observeMany 200 $
(,,) <$> each [0..] <#> each [0..] <#> each [0..]

MonadFix instance for Rand monad

I would like to generate infinite stream of numbers with Rand monad from System.Random.MWC.Monad. If only there would be a MonadFix instance for this monad, or instance like this:
instance (PrimMonad m) => MonadFix m where
...
then one could write:
runWithSystemRandom (mfix (\ xs -> uniform >>= \x -> return (x:xs)))
There isn't one though.
I was going through MonadFix docs but I don't see an obvious way of implementing this instance.
You can write a MonadFix instance. However, the code will not generate an infinite stream of distinct random numbers. The argument to mfix is a function that calls uniform exactly once. When the code is run, it will call uniform exactly once, and create an infinite list containing the result.
You can try the equivalent IO code to see what happens:
import System.Random
import Control.Monad.Fix
main = print . take 10 =<< mfix (\xs -> randomIO >>= (\x -> return (x : xs :: [Int])))
It seems that you want to use a stateful random number generator, and you want to run the generator and collect its results lazily. That isn't possible without careful use of unsafePerformIO. Unless you need to produce many random numbers quickly, you can use a pure RNG function such as randomRs instead.
A question: how do you wish to generate your initial seed?
The problem is that MWS is built on the "primitive" package which abstracts only IO and strict (Control.Monad.ST.ST s). It does not also abstract lazy (Control.Monad.ST.Lazy.ST s).
Perhaps one could make instances for "primitive" to cover lazy ST and then MWS could be lazy.
UPDATE: I can make this work using Control.Monad.ST.Lazy by using strictToLazyST:
module Main where
import Control.Monad(replicateM)
import qualified Control.Monad.ST as S
import qualified Control.Monad.ST.Lazy as L
import qualified System.Random.MWC as A
foo :: Int -> L.ST s [Int]
foo i = do rest <- foo $! succ i
return (i:rest)
splam :: A.Gen s -> S.ST s Int
splam = A.uniformR (0,100)
getS :: Int -> S.ST s [Int]
getS n = do gen <- A.create
replicateM n (splam gen)
getL :: Int -> L.ST s [Int]
getL n = do gen <- createLazy
replicateM n (L.strictToLazyST (splam gen))
createLazy :: L.ST s (A.Gen s)
createLazy = L.strictToLazyST A.create
makeLots :: A.Gen s -> L.ST s [Int]
makeLots gen = do x <- L.strictToLazyST (A.uniformR (0,100) gen)
rest <- makeLots gen
return (x:rest)
main = do
print (S.runST (getS 8))
print (L.runST (getL 8))
let inf = L.runST (foo 0) :: [Int]
print (take 10 inf)
let inf3 = L.runST (createLazy >>= makeLots) :: [Int]
print (take 10 inf3)
(This would be better suited as a comment to Heatsink's answer, but it's a bit too long.)
MonadFix instances must adhere to several laws. One of them is left shrinking/thightening:
mfix (\x -> a >>= \y -> f x y) = a >>= \y -> mfix (\x -> f x y)
This law allows to rewrite your expression as
mfix (\xs -> uniform >>= \x -> return (x:xs))
= uniform >>= \x -> mfix (\xs -> return (x:xs))
= uniform >>= \x -> mfix (return . (x :))
Using another law, purity mfix (return . h) = return (fix h), we can further simplify to
= uniform >>= \x -> return (fix (x :))
and using the standard monad laws and rewriting fix (x :) as repeat x
= liftM (\x -> fix (x :)) uniform
= liftM repeat uniform
Therefore, the result is indeed one invocation of uniform and then just repeating the single value indefinitely.

Improving code to generate a distribution

I am new to Haskell and I wonder how/if I can make this code more efficient and tidy. It seems unnecessarily long and untidy.
My script generates a list of 10 averages of 10 coin flips.
import Data.List
import System.Random
type Rand a = StdGen -> Maybe (a,StdGen)
output = do
gen <- newStdGen
return $ distBernoulli 10 10 gen
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n gen = [fromIntegral (sum x) / fromIntegral (length x) | x <- lst]
where lst = splitList (randomList (n*m) gen) n
splitList :: [Int] -> Int -> [[Int]]
splitList [] n = []
splitList lst n = take n lst : splitList (drop n lst) n
randomList :: Int -> StdGen -> [Int]
randomList n = take n . unfoldr trialBernoulli
trialBernoulli :: Rand Int
trialBernoulli gen = Just ((2*x)-1,y)
where (x,y) = randomR (0,1) gen
Any help would be appreciated, thanks.
I'd tackle this problem in a slightly different way. First I'd define a function that would give me an infinite sampling of flips from a Bernoulli distribution with success probability p:
flips :: Double -> StdGen -> [Bool]
flips p = map (< p) . randoms
Then I'd write distBernoulli as follows:
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n = take m . map avg . splitEvery n . map val . flips 0.5
where
val True = 1
val False = -1
avg = (/ fromIntegral n) . sum
I think this matches your definition of distBernoulli:
*Main> distBernoulli 10 10 $ mkStdGen 0
[-0.2,0.4,0.4,0.0,0.0,0.2,0.0,0.6,0.2,0.0]
(Note that I'm using splitEvery from the handy split package, so you'd have to install the package and add import Data.List.Split (splitEvery) to your imports.)
This approach is slightly more general, and I think a little neater, but really the main difference is just that I'm using randoms and splitEvery.
EDIT: I posted this too fast and didn't match behavior, it should be good now.
import Control.Monad.Random
import Control.Monad (liftM, replicateM)
KNOWLEDGE: If you like randoms then use MonadRandom - it rocks.
STYLE: Only importing symbols you use helps readability and sometimes maintainability.
output :: IO [Double]
output = liftM (map dist) getLists
Note: I've given output an explicit type, but know it doesn't have to be IO.
STYLE:
1) Its usually good to separate your IO from pure functions. Here I've divided out the getting of random lists from the calculation of distributions. In your case it was pure but you combined getting "random" lists via a generator with the distribution function; I would divide those parts up.
2) Read Do notation considered harmful. Consider using >>= instead of
output = do
gen <- new
return $ dist gen
you can do:
output = new >>= dist
Wow!
dist :: [Int] -> Double
dist lst = (fromIntegral (sum lst) / fromIntegral (length lst))
getLists :: MonadRandom m => Int -> Int -> m [[Int]]
getLists m n= replicateM m (getList n)
KNOWLEDGE In Control.Monad anything ending in an M is like the original but for monads. In this case, replicateM should be familiar if you used the Data.List replicate function.
getList :: MonadRandom m => Int -> m [Int]
getList m = liftM (map (subtract 1 . (*2)) . take m) (getRandomRs (0,1::Int))
STYLE: If I do something lots of times I like to have a single instance in its own function (getList) then the repetition in a separate function.
I'm not sure I understand your code or your question...
But it seems to me all you'd need to do is generate a list of random ones and zeroes, and then divide each of them by their length with a map and add them together with a foldl.
Something like:
makeList n lis = if n /= 0 then
makeList (n-1) randomR(0,1) : lis
else
lis
And then make it apply a Map and Foldl or Foldr to it.
Using the above, I am now using this.
import Data.List
import System.Random
type Rand a = [a]
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n gen = [fromIntegral (sum x) / fromIntegral (length x) | x <- lst]
where lst = take m $ splitList (listBernoulli gen) n
listBernoulli :: StdGen -> Rand Int
listBernoulli = map (\x -> (x*2)-1) . randomRs (0,1)
splitList :: [Int] -> Int -> [[Int]]
splitList lst n = take n lst : splitList (drop n lst) n
Thanks for your help, and I welcome any further comments :)

How to use 'oneof' in quickCheck (Haskell)

I am trying to write a prop that changes a Sudoku and then checks if it's still valid.
However, I am not sure how to use the "oneof"-function properly. Can you give me some hints, please?
prop_candidates :: Sudoku -> Bool
prop_candidates su = isSudoku newSu && isOkay newSu
where
newSu = update su aBlank aCandidate
aCandidate = oneof [return x | x <- candidates su aBlank]
aBlank = oneof [return x | x <- (blanks su)]
Here are some more info...
type Pos = (Int, Int)
update :: Sudoku -> Pos -> Maybe Int -> Sudoku
blanks :: Sudoku -> [Pos]
candidates :: Sudoku -> Pos -> [Int]
[return x | x <- (blanks example)] :: (Monad m) => [m Pos]
I have struggeled with this prop for 3 hours now, so any ideas are welcome!
What I was driving at is that you have a type mix-up. Namely, aBlank is not a Pos, but a Gen Pos, so update su aBlank aCandidate makes no sense! In fact, what you want is a way to generate a new sudoku given an initial sudoku; in other words a function
similarSudoku :: Sudoku -> Gen Sudoku
Now we can write it:
similarSudoku su = do aBlank <- elements (blanks su)
-- simpler than oneOf [return x | x <- blanks su]
aCandidate <- elements (candidates su aBlank)
return (update su aBlank aCandidate)
or even simpler:
similarSudoku su = liftM2 (update su) (elements (blanks su)) (elements (candidates su aBlank))
And the property looks like
prop_similar :: Sudoku -> Gen Bool
prop_similar su = do newSu <- similarSudoku su
return (isSudoku newSu && isOkay newSu)
Since there are instances
Testable Bool
Testable prop => Testable (Gen prop)
(Arbitrary a, Show a, Testable prop) => Testable (a -> prop)
Sudoku -> Gen Bool is Testable as well (assuming instance Arbitrary Sudoku).
On my blog, I wrote a simple craps simulator with QuickCheck tests that use oneof to generate interesting rolls.
Say we have a super-simple Sudoku of a single row:
module Main where
import Control.Monad
import Data.List
import Test.QuickCheck
import Debug.Trace
type Pos = Int
data Sudoku = Sudoku [Char] deriving (Show)
No super-simple Sudoku should have repeated values:
prop_noRepeats :: Sudoku -> Bool
prop_noRepeats s#(Sudoku xs) =
trace (show s) $ all ((==1) . length) $
filter ((/='.') . head) $
group $ sort xs
You might generate a super-simple Sudoku with
instance Arbitrary Sudoku where
arbitrary = sized board :: Gen Sudoku
where board :: Int -> Gen Sudoku
board 0 = Sudoku `liftM` shuffle values
board n | n > 6 = resize 6 arbitrary
| otherwise =
do xs <- shuffle values
let removed = take n xs
dots = take n $ repeat '.'
remain = values \\ removed
ys <- shuffle $ dots ++ remain
return $ Sudoku ys
values = ['1' .. '9']
shuffle :: (Eq a) => [a] -> Gen [a]
shuffle [] = return []
shuffle xs = do x <- oneof $ map return xs
ys <- shuffle $ delete x xs
return (x:ys)
The trace is there to show the randomly generated boards:
*Main> quickCheck prop_noRepeats
Sudoku "629387451"
Sudoku "91.235786"
Sudoku "1423.6.95"
Sudoku "613.4..87"
Sudoku "6..5..894"
Sudoku "7.2..49.."
Sudoku "24....1.."
[...]
+++ OK, passed 100 tests.
it seems that aBlank :: Gen Pos which does not match the way it is used as an argument of candidates :: Sudoku -> Pos -> [Int].
I've been looking through here to find a way to convert Gen a to a which would allow you to use it with candidates. The best i could see is the generate function.
Tell me if I'm missing something...

Resources