How to use 'oneof' in quickCheck (Haskell) - 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...

Related

How do I deal with the error "No instance for (Control.Monad.IO.Class.MonadIO [])"?

Good evening everybody! This is a question concerning Haskell. I want to get x random elements from a list by using a function.
The problem I get is that when I try to use random numbers, with randomRIO. I get the error message:
No instance for (Control.Monad.IO.Class.MonadIO [])
arising from a use of `randomRIO'
This error message suddenly goes away when i use print or return. But I dont want to use print, and return messes up the output to a nested list [[a]] instead of [a].
Does any of you have a tip on what I can do to extract x random elements from the list, in the form of a list?
The type would be something like this. xRanElems :: [a] -> Int -> [a]
where the second Int is an accumulator but I got that covered.
xRanElems xs n = do
r <- randomRIO (0, n)
xRanElems2 xs n r
where n is just length xs - 1
xRanElems2 xs n r = (xs !! r) : (xRanElems (xsWithOutSelectedElem xs r) (n-1))
Thankful for any input!
The following typechecks:
import System.Random
xRanElems :: [a] -> Int -> IO [a]
xRanElems xs n = do
-- randomRIO :: Random t
-- => (t, t) -> IO t
r <- randomRIO (0, n) -- r :: Int
xRanElems2 xs n r
xRanElems2 :: [a] -> Int -> Int -> IO [a]
xRanElems2 xs n r =
let (a,b:c) = splitAt r xs
in
fmap (b :) -- [a] -> [a]
(xRanElems -- IO [a] -> IO [a]
(a++c) (n-1))
Trying to run it, e.g. with xRanElems [1..3] 2, reveals that it loops forever.
This is because you need to provide the base case in xRanElems to stop the recursion, e.g. returning [] when n <= 0.
The above code also contains an off-by-1 error which you're invited to fix.

How to know in Haskell in what row and column of a table ([[a]]) you are

I want to make a sudoku solver in Haskell (as an exercise). My idea is:
I have t :: [[Int]] representing a 9x9 grid so that it contains 0 in an empty field and 1-9 in a solved field.
A function solve :: [[Int]] -> [[Int]] returns the solved sudoku.
Here is a rough sketch of it (i'd like to point out i'm a beginner, i know it is not the most optimal code):
solve :: [[Int]] -> [[Int]]
solve t
| null (filter (elem 0) t) = t
| t /= beSmart t = solve (beSmart t)
| otherwise = guess t
The function beSmart :: [[Int]] -> [[Int]] tries to solve it by applying some solving algorithms, but if methodical approach fails (beSmart returns the unchanged sudoku table in that case) it should try to guess some numbers (and i'll think of that function later). In order to fill in an empty field, i have to find it first. And here's the problem:
beSmart :: [[Int]] -> [[Int]]
beSmart t = map f t
where f row
| elem 0 row = map unsolvedRow row
| otherwise = row
where unsolvedRow a
| a == 0 = tryToDo t r c --?!?!?!?! skip
| otherwise = a
The function tryToDo :: [[Int]]] -> Int -> Int - > Int needs the row and column of the field i'm trying to change, but i have no idea how to get that information. How do i get from map what element of the list i am in at the moment? Or is there a better way to move around in the table? I come from iterative and procedural programing and i understand that perhaps my approach to the problem is wrong when it comes to functional programing.
I know this is not really an answer to your question, but I would argue, that usually you would want a different representation (one that keeps a more detailed view of what you know about the sudoku puzzle, in your attempted solution you can only distinguish a solved cell from a cell that is free to assume any value). Sudoku is a classical instance of CSP. Where modern approaches offer many fairly general smart propagation rules, such as unit propagation (blocking a digit in neighboring cells once used somewhere), but also many other, see AC-3 for further details. Other related topics include SAT/SMT and you might find the algorithm DPLL also interesting. In the heart of most solvers there usually is some kind of a search engine to deal with non-determinism (not every instance must have a single solution that is directly derivable from the initial configuration of the instance by application of inference rules). There are also techniques such as CDCL to direct the search.
To address the question in the title, to know where you are, its probably best if you abstract the traversal of your table so that each step has access to the coordinates, you can for example zip a list of rows with [0..] (zip [0..] rows) to number the rows, when you then map a function over the zipped lists, you will have access to pairs (index, row), the same applies to columns. Just a sketch of the idea:
mapTable :: (Int -> Int -> a -> b) -> [[a]] -> [[b]]
mapTable f rows = map (\(r, rs) -> mapRow (f r) rs) $ zip [0..] rows
mapRow :: (Int -> a -> b) -> [a] -> [b]
mapRow f cols = map (uncurry f) $ zip [0..] cols
or use fold to turn your table into something else (for example to search for a unit cell):
foldrTable :: (Int -> Int -> a -> b -> b) -> b -> [[a]] -> b
foldrTable f z rows = foldr (\(r, rs) b -> foldrRow (f r) b rs) z $ zip [0..] rows
foldrRow :: (Int -> a -> b -> b) -> b -> [a] -> b
foldrRow f z cols = foldr (uncurry f) z $ zip [0..] cols
to find which cell is unital:
foldrTable
(\x y v acc -> if length v == 1 then Just (x, y) else acc)
Nothing
[[[1..9],[1..9],[1..9]],[[1..9],[1..9],[1..9]],[[1..9],[1],[1..9]]]
by using Monoid you can refactor it:
import Data.Monoid
foldrTable' :: Monoid b => (Int -> Int -> a -> b) -> [[a]] -> b
foldrTable' f rows = foldrTable (\r c a b -> b <> f r c a) mempty rows
unit :: Int -> Int -> [a] -> Maybe (Int, Int)
unit x y c | length c == 1 = Just (x, y)
| otherwise = Nothing
firstUnit :: [[[a]]] -> Maybe (Int, Int)
firstUnit = getFirst . foldrTable' (\r c v -> First $ unit r c v)
so now you would do
firstUnit [[[1..9],[1..9],[1..9]],[[1,2],[3,4],[5]]]
to obtain
Just (1, 2)
correctly determining that the first unit cell is at position 1,2 in the table.
[[Int]] is a good type for a sodoku. But map does not give any info regarding the place it is in. This is one of the ideas behind map.
You could zip together the index with the value. But a better idea would be to pass the whole [[Int]] and the indexes to to the function. So its type would become:
f :: [[Int]] -> Int -> Int -> [[Int]]
inside the function you can now access the current element by
t !! x !! y
Already did this a while ago as a learning example. It is definitely not the nicest solution, but it worked for me.
import Data.List
import Data.Maybe
import Data.Char
sodoku="\
\-9-----1-\
\8-4-2-3-7\
\-6-9-7-2-\
\--5-3-1--\
\-7-5-1-3-\
\--3-9-8--\
\-2-8-5-6-\
\1-7-6-4-9\
\-3-----8-"
sodoku2="\
\----13---\
\7-5------\
\1----547-\
\--418----\
\951-67843\
\-2---4--1\
\-6235-9-7\
\--7-98--4\
\89----1-5"
data Position = Position (Int, Int) deriving (Show)
data Sodoku = Sodoku [Int]
insertAtN :: Int -> a -> [a] -> [a]
insertAtN n y xs = intercalate [y] . groups n $ xs
where
groups n xs = takeWhile (not.null) . unfoldr (Just . splitAt n) $ xs
instance Show Sodoku where
show (Sodoku s) = (insertAtN 9 '\n' $ map intToDigit s) ++ "\n"
convertDigit :: Char -> Int
convertDigit x = case x of
'-' -> 0
x -> if digit>=1 && digit<=9 then
digit
else
0
where digit=digitToInt x
convertSodoku :: String -> Sodoku
convertSodoku x = Sodoku $ map convertDigit x
adjacentFields :: Position -> [Position]
adjacentFields (Position (x,y)) =
[Position (i,y) | i<-[0..8]] ++
[Position (x,j) | j<-[0..8]] ++
[Position (u+i,v+j) | i<-[0..2], j<-[0..2]]
where
u=3*(x `div` 3)
v=3*(y `div` 3)
positionToField :: Position -> Int
positionToField (Position (x,y)) = x+y*9
fieldToPosition :: Int -> Position
fieldToPosition x = Position (x `mod` 9, x `div` 9)
getDigit :: Sodoku -> Position -> Int
getDigit (Sodoku x) pos = x !! (positionToField pos )
getAdjacentDigits :: Sodoku -> Position -> [Int]
getAdjacentDigits s p = nub digitList
where
digitList=filter (\x->x/=0) $ map (getDigit s) (adjacentFields p)
getFreePositions :: Sodoku -> [Position]
getFreePositions (Sodoku x) = map fieldToPosition $ elemIndices 0 x
isSolved :: Sodoku -> Bool
isSolved s = (length $ getFreePositions s)==0
isDeadEnd :: Sodoku -> Bool
isDeadEnd s = any (\x->x==0) $ map length $ map (getValidDigits s)$ getFreePositions s
setDigit :: Sodoku -> Position -> Int -> Sodoku
setDigit (Sodoku x) pos digit = Sodoku $ h ++ [digit] ++ t
where
field=positionToField pos
h=fst $ splitAt field x
t=tail$ snd $ splitAt field x
getValidDigits :: Sodoku -> Position -> [Int]
getValidDigits s p = [1..9] \\ (getAdjacentDigits s p)
-- Select numbers with few possible choices first to increase execution time
sortImpl :: (Position, [Int]) -> (Position, [Int]) -> Ordering
sortImpl (_, i1) (_, i2)
| length(i1)<length(i2) = LT
| length(i1)>length(i2) = GT
| length(i1)==length(i2) = EQ
selectMoves :: Sodoku -> Maybe (Position, [Int])
selectMoves s
| length(posDigitList)>0 = Just (head posDigitList)
| otherwise = Nothing
where
posDigitList=sortBy sortImpl $ zip freePos validDigits
validDigits=map (getValidDigits s) freePos
freePos=getFreePositions s
createMoves :: Sodoku -> [Sodoku]
createMoves s=
case selectMoves s of
Nothing -> []
(Just (pos, digits)) -> [setDigit s pos d|d<-digits]
solveStep :: Sodoku -> [Sodoku]
solveStep s
| (isSolved s) = [s]
| (isDeadEnd s )==True = []
| otherwise = createMoves s
solve :: Sodoku -> [Sodoku]
solve s
| (isSolved s) = [s]
| (isDeadEnd s)==True = []
| otherwise=concat $ map solve (solveStep s)
s=convertSodoku sodoku2
readSodoku :: String -> Sodoku
readSodoku x = Sodoku []

Combining State and List Monads

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.

Difficulty getting desired output file type in function

After going through a couple of chapters of "Learn You A Haskell", I wanted to write something hands on and decided to implement a Sudoku solver.I am trying to implement the B2 function from here: http://www.cse.chalmers.se/edu/year/2013/course/TDA555/lab3.html
Here's my code:
data Sudoku = Sudoku { getSudoku :: [[Maybe Int]] } deriving (Show, Eq)
printSudoku :: Sudoku -> IO ()
printSudoku s = do
putStrLn . unlines . map (map (maybe '.' (head . show))) $ rows s
stringToSudoku :: String -> [[Maybe Int]]
stringToSudoku [] = []
stringToSudoku s = (f x):stringToSudoku y
where (x,y) = splitAt 9 s
f = map (\x -> if (digitToInt x)==0 then Nothing else Just (digitToInt x))
readSudoku :: FilePath -> IO Sudoku
readSudoku path = do
handle <- openFile path ReadMode
contents <- hGetContents handle
return $ Sudoku $ stringToSudoku contents
I am able to get the desired output:
readSudoku "sudoku.txt" >>= printSudoku
.......1.
4........
.2.......
....5.4.7
..8...3..
..1.9....
3..4..2..
.5.1.....
...8.6...
However, I had to convert [[Maybe Int]] to Sudoku in the readSudoku function. It should be possible to do this in the stringToSudoku function right?
The sudoku.txt file contains 1 line
000000010400000000020000000000050407008000300001090000300400200050100000000806000
If you want stringToSudoku to return Sudoku you could do:
stringToSudoku :: String -> Sudoku
stringToSudoku s = Sudoku $ stringToGrid s
where stringToGrid [] = []
stringToGrid s = let (x, y) = splitAt 9 s
f = map (\x -> if (digitToInt x)==0 then Nothing else Just (digitToInt x))
in (f x):stringToGrid y

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

Resources