Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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!

like image 521
Mickel Avatar asked Dec 01 '09 20:12

Mickel


1 Answers

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).

like image 186
Alexey Romanov Avatar answered Sep 23 '22 10:09

Alexey Romanov