How to display a reason of a failed test property with quickcheck? - haskell

What is the best practice to display reasons for a failed property test when it is tested via QuickCheck?
Consider for example:
prop a b = res /= []
where
(res, reason) = checkCode a b
Then the a session could look like:
> quickCheck prop
Falsifiable, after 48 tests:
42
23
But for debugging it would be really convenient to show the reason for failure as part of the quickCheck falsifable report.
I have hacked it like this:
prop a b = if res /= [] then traceShow reason False else True
where
(res, reason) = checkCode a b
Is there is a better/nicer or more quickcheckish way to do it?

I assume that your "reason" variable contains some kind of test-specific data on what went wrong. You could instead return a "Result", which contains both success/fail/invalid conditions and a string explaining what went wrong. Properties that return Results are handled by QuickCheck in exactly the same way as properties that return Bool.
(edit) Like this:
module QtTest where
import Test.QuickCheck
import Test.QuickCheck.Property as P
-- Always return success
prop_one :: Integer -> P.Result
prop_one _ = MkResult (Just True) True "always succeeds" False [] []
-- Always return failure
prop_two :: Integer -> P.Result
prop_two n = MkResult (Just False) True ("always fails: n = " ++ show n) False [] []
Note that it is the "Result" type defined in Test.QuickCheck.Property you want.
There are also some combinators defined in Test.QuickCheck.Property which help you compose the Result rather than calling the constructor directly, such as
prop_three :: Integer -> Property
prop_three n = printTestCase ("always fails: n = " ++ show n) False
I guess it would be better style to use those.

This works in the same way as Paul Johnson's answer but is more concise and robust to changes in MkResult:
import Test.QuickCheck.Property (succeeded, failed, reason)
prop a b =
if res /= []
then succeeded
else failed { reason = reason }
where
(res, reason) = checkCode a b

Because QuickCheck gives you the inputs to the function, and because the code under test is pure (it is, right?), you can just feed those inputs to the function and get the result. This is more flexible, because with those inputs you can also repeatedly test with tweaks to the original function until it's correct.

This is my solution (I use counterexample instead of printTestCase since the later one is deprecated now):
(<?>) :: (Testable p) => p -> String -> Property
(<?>) = flip (Test.QuickCheck.counterexample . ("Extra Info: " ++))
infixl 2 <?>
Usage:
main :: IO ()
main = hspec $ do
describe "math" $ do
prop "sum-of-square-le-square-of-sum" $ do
\(x :: Int) (y :: Int) ->
x * x + y * y <= (x + y) * (x + y) <?> show (x * x, y * y, x + y)
So when a test case fails, you can see something like:
*** Failed! Falsifiable, Falsifiable (after 2 tests):
1
-1
Extra Info: (1,1,0)
You can also use <?> together with .&&., .||., === and ==> etc.:
describe "math" $ do
prop "sum-of-square-le-square-of-sum" $ do
\(x :: Int) (y :: Int) ->
x * x + y * y <= (x + y) * (x + y) <?> show (x * x, y * y, x + y) .||. (1==0) <?> "haha"

Related

Parse error in pattern x * y (of case statement)

I have this code:
module BalancedTwoDozenMultDrill where
import BalancedTwoDozenLib
myRandoms :: Int -> IO [Int]
myRandoms n = let x = 24^n `div` 2 in randomRs (-x,x) <$> getStdGen
drill :: [Int] -> IO ()
drill (x:y:rs) = do
putStr $ showInt x ++ " × " ++ showInt y ++ " = "
a <- getLine
case a of
"" -> return ()
showInt (x * y) -> do -- <= here
putStrLn "Correct"
drill rs
_ -> do
putStrLn $ "Wrong; " ++ showInt (x * y)
drill rs
main :: IO [Int]
main = drill =<< myRandoms =<< readLn
and get error:
BalancedTwoDozenMultDrill.hs:11:18: Parse error in pattern: x * y
However, replacing part of the case statement with:
-- ...stuff
let i = showInt (x * y)
case a of
"" -> return ()
i -> do
-- stuff...
Makes it parse (it goes to “not in scope” errors, which I can fix). The only reason I see for the first fragment being wrong is that there is function application going on. Is it true that I can't use ordinary function application for the alternatives in a case statement?
When you have a pattern in a case statement, it has to follow the same rules as that in pattern matching on function arguments. Only literals, constructors, and the wildcard _ can be matched on, not function applications. Instead, you could do something more like
a <- getLine
let xyStr = showInt (x * y) -- Avoid recomputation with a let binding
when (not $ null a) $ do
if a == xyStr
then do
putStrLn "Correct"
drill rs
else do
putStrLn $ "Wrong; " ++ xyStr
drill rs
You'll need to import when from Control.Monad, though.
The reason why you have to follow the same rules in case statements as in pattern matching in function definitions is because the compiler actually converts something like
head :: [a] -> a
head (x:xs) = x
head _ = error "Prelude.head: empty list"
Into
head :: [a] -> a
head list = case list of
(x:xs) -> x
_ -> error "Prelude.head: empty list"
The only reason we have the former version is convenience, it often makes for prettier looking code.
This link should be able to give you a more thorough explanation as to what is and isn't valid pattern matching constructs.
The other problem you had was trying to replace showInt (x * y) with i where let i = showInt (x * y). When you do this, you first bind the value showInt (x * y) to the name i, then in your case statement you have the patterns
"" -> ...
i -> ...
_ -> ...
So now your pattern is i, and it will act like a catch-all pattern after "". This rebinds the name i for the scope of that case statement.
A good rule to keep in mind is that you can't pattern match against a value obtained at run time, you have to check with equality or other comparison operations.
Although an answer already accepted I'd just mention there is a bit tricky way how use a boolean expressions in a case expression - by using guards:
case () of
_
| a == "" -> return ()
| showInt (x * y) -> do -- <= here
putStrLn "Correct"
drill rs
| otherwise -> do
putStrLn $ "Wrong; " ++ showInt (x * y)
drill rs

Defining a Boolean function on Haskell that determines if an element occurs once in a list

So I'm trying to define a function in Haskell that if given an integer and a list of integers will give a 'true' or 'false' whether the integer occurs only once or not.
So far I've got:
let once :: Eq a => a -> [a] -> Bool; once x l =
But I haven't finished writing the code yet. I'm very new to Haskell as you may be able to tell.
Start off by using pattern matching:
once x [] =
once x (y:ys) =
This won't give you a good program immediately, but it will lead you in the right direction.
Here's a solution that doesn't use pattern matching explicitly. Instead, it keeps track of a Bool which represents if a occurance has already been found.
As others have pointed out, this is probably a homework problem, so I've intentionally left the then and else branches blank. I encourage user3482534 to experiment with this code and fill them in themselves.
once :: Eq a => a -> [a] -> Bool
once a = foldr f False
where f x b = if x == a then ??? else ???
Edit: The naive implementation I was originally thinking of was:
once :: Eq a => a -> [a] -> Bool
once a = foldr f False
where f x b = if x == a then b /= True else b
but this is incorrect as,
λ. once 'x' "xxx"
True
which should, of course, be False as 'x' occurs more than exactly once.
However, to show that it is possible to write once using a fold, here's a revised version that uses a custom monoid to keep track of how many times the element has occured:
import Data.List
import Data.Foldable
import Data.Monoid
data Occur = Zero | Once | Many
deriving Eq
instance Monoid Occur where
mempty = Zero
Zero `mappend` x = x
x `mappend` Zero = x
_ `mappend` _ = Many
once :: Eq a => a -> [a] -> Bool
once a = (==) Once . foldMap f
where f x = if x == a then Once else Zero
main = do
let xss = inits "xxxxx"
print $ map (once 'x') xss
which prints
[False,True,False,False,False]
as expected.
The structure of once is similar, but not identical, to the original.
I'll answer this as if it were a homework question since it looks like one.
Read about pattern matching in function declarations, especially when they give an example of processing a list. You'll use tools from Data.List later, but probably your professor is teaching about pattern matching.
Think about a function that maps values to a 1 or 0 depending on whethere there is a match ...
match :: a -> [a] -> [Int]
match x xs = map -- fill in the thing here such that
-- match 3 [1,2,3,4,5] == [0,0,1,0,0]
Note that there is the sum function that takes a list of numbers and returns the sum of the numbers in the list. So to count the matches a function can take the match function and return the counts.
countN :: a -> [a] -> Int
countN x xs = ? $ match x xs
And finally a function that exploits the countN function to check for a count of only 1. (==1).
Hope you can figure out the rest ...
You can filter the list and then check the length of the resulting list. If length == 1, you have only one occurrence of the given Integer:
once :: Eq a => a -> [a] -> Bool
once x = (== 1) . length . filter (== x)
For counting generally, with import Data.List (foldl'), pointfree
count pred = foldl' (\ n x -> if pred x then n + 1 else n) 0
applicable like
count (< 10) [1 .. 10] == 9
count (== 'l') "Hello" == 2
gives
once pred xs = count pred xs == 1
Efficient O(n) short-circuit predicated form, testing whether the predicate is satisfied exactly once:
once :: (a -> Bool) -> [a] -> Bool
once pred list = one list 0
where
one [] 1 = True
one [] _ = False
one _ 2 = False
one (x : xs) n | pred x = one xs (n + 1)
| otherwise = one xs n
Or, using any:
none pred = not . any pred
once :: (a -> Bool) -> [a] -> Bool
once _ [] = False
once pred (x : xs) | pred x = none pred xs
| otherwise = one pred xs
gives
elemOnce y = once (== y)
which
elemOnce 47 [1,1,2] == False
elemOnce 2 [1,1,2] == True
elemOnce 81 [81,81,2] == False

Custom Ord instance hangs on lists

import Data.Function (on)
import Data.List (sort)
data Monomial = Monomial
{ m_coeff :: Coefficient
, m_powers :: [(Variable, Power)]
}
deriving ()
instance Ord Monomial where
(>=) = on (>=) m_powers
instance Eq Monomial where
(==) = on (==) m_powers
That's an excerpt from my code, cut down to principal size. Let's try comparing:
*Main> (Monomial 1 [("x",2)]) > (Monomial (-1) [])
/* Computation hangs here */
*Main> (Monomial 1 [("x",2)]) < (Monomial (-1) [])
/* Computation hangs here */
On a side note, it's interesting that if I replace s/(>=)/(>)/g in instance declaration, it will not hang on the fist pair, but still will on the second:
*Main> (Monomial 1 [("x",2)]) > (Monomial (-1) [])
True
*Main> (Monomial 1 [("x",2)]) < (Monomial (-1) [])
/* Computation hangs here */
Although the standard states minimal declaration of Eq instance to be either$compare$ or $(>=)$.
What might be the problem here? (>=) on lists seems to work just fine.
Short answer:
You need to provide either (<=) or compare to have a complete definition for Ord, not (>=).
Longer explanation:
It is common for type classes in Haskell to have default implementations of some methods implemented in terms of other methods. You can then choose which ones you want to implement. For example, Eq looks like this:
class Eq a where
(==), (/=) :: a -> a -> Bool
x /= y = not (x == y)
x == y = not (x /= y)
Here, you must either implement (==) or (/=), otherwise trying to use either of them will cause an infinite loop. Which methods you need to provide is usually listed as the minimal complete definition in the documentation.
The minimal complete definition for Ord instances, as listed in the documentation, is either (<=) or compare. Since you've only provided (>=), you have not provided a complete definition, and therefore some of the methods will loop. You can fix it by e.g. changing your instance to provide compare instead.
instance Ord Monomial where
compare = compare `on` m_powers
Let's look at the default instance for Ord:
class (Eq a) => Ord a where
compare :: a -> a -> Ordering
(<), (<=), (>), (>=) :: a -> a -> Bool
max, min :: a -> a -> a
compare x y = if x == y then EQ
-- NB: must be '<=' not '<' to validate the
-- above claim about the minimal things that
-- can be defined for an instance of Ord:
else if x <= y then LT
else GT
x < y = case compare x y of { LT -> True; _ -> False }
x <= y = case compare x y of { GT -> False; _ -> True }
x > y = case compare x y of { GT -> True; _ -> False }
x >= y = case compare x y of { LT -> False; _ -> True }
-- These two default methods use '<=' rather than 'compare'
-- because the latter is often more expensive
max x y = if x <= y then y else x
min x y = if x <= y then x else y
So, if you supply >= and == as above, only, then you are in trouble, since:
> is defined in terms of compare
But
compare is defined in terms of <=
<= is defined in terms of compare
So you have an infinite loop!
A minimum definition must defined <= or compare, not '>=`.

Printing in Haskell

I have a function that returns Floats (or some other type). I am using my program as a module in ghci. How would I print out info at certain points in the program? For example, if I detect bad input to a function, how do I print out an error message?
There are a few cases here, depending on what you want to do.
The straight forward sprinkling of printfs as a method of debugging is not going to work very well in Haskell.
If you have a partial function, I would suggest using Either or Maybe as a solution.
For example:
lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup x [] = Nothing
lookup x ((k,v):ys) | x == k = Just v
| otherwise = lookup x ys
lookup takes a key, and a list of key-value pairs and return Just the value associated with that key, or Nothing if the key is not in the list.
doMath :: Char -> Int -> Int -> Either String Int
doMath '+' x y = Right (x + y)
doMath '*' x y = Right (x * y)
doMath '/' x 0 = Left "Division by zero"
doMath '/' x y = Right (x / y)
doMath '-' x y = Right (x - y)
doMath c x y = Left ("Bad operator: " ++ show c)
Either is like maybe, in that if you can, you will return the right result. Otherwise you take what's left.
If your function really has an impossible case, then you can use the function error, which throws a pretty much uncatchable error with a string. It's not pretty, but it will help point you in the right direction when doing a post-mortem after the impossible does happen.
Because there are no side effects in pure code, you basically have three options:
You can print an error message and throw an exception, which usually terminates the program unless you catch it:
myDiv x 0 = error "Division by zero"
myDiv x y = x / y
You can print an error message and return some value:
import Debug.Trace
myDiv x y = trace ("Trying to divide " ++ show x ++ " by " ++ show y) (x / y)
You can return a value which describes the error in some way, e.g. Maybe or Either String:
myDivMaybe x 0 = Nothing
myDivMaybe x y = Just (x / y)
myDivEither x 0 = Left "Won't divide by zero"
myDivEither x y = Right (x / y)
You usually use error when the input is really invalid and you don't mind a runtime error in that case. trace is usually used for debugging purposes. If you want to avoid runtime errors on invalid input, you can use Maybe or Either.

Doing a binary search on some elements in Haskell

I'm trying to complete the last part of my Haskell homework and I'm stuck, my code so far:
data Entry = Entry (String, String)
class Lexico a where
(<!), (=!), (>!) :: a -> a -> Bool
instance Lexico Entry where
Entry (a,_) <! Entry (b,_) = a < b
Entry (a,_) =! Entry (b,_) = a == b
Entry (a,_) >! Entry (b,_) = a > b
entries :: [(String, String)]
entries = [("saves", "en vaut"), ("time", "temps"), ("in", "<`a>"),
("{", "{"), ("A", "Un"), ("}", "}"), ("stitch", "point"),
("nine.", "cent."), ("Zazie", "Zazie")]
build :: (String, String) -> Entry
build (a, b) = Entry (a, b)
diction :: [Entry]
diction = quiksrt (map build entries)
size :: [a] -> Integer
size [] = 0
size (x:xs) = 1+ size xs
quiksrt :: Lexico a => [a] -> [a]
quiksrt [] = []
quiksrt (x:xs)
|(size [y|y <- xs, y =! x]) > 0 = error "Duplicates not allowed."
|otherwise = quiksrt [y|y <- xs, y <! x]++ [x] ++ quiksrt [y|y <- xs, y >! x]
english :: String
english = "A stitch in time save nine."
show :: Entry -> String
show (Entry (a, b)) = "(" ++ Prelude.show a ++ ", " ++ Prelude.show b ++ ")"
showAll :: [Entry] -> String
showAll [] = []
showAll (x:xs) = Main.show x ++ "\n" ++ showAll xs
main :: IO ()
main = do putStr (showAll ( diction ))
The question asks:
Write a Haskell programs that takes
the English sentence 'english', looks
up each word in the English-French
dictionary using binary search,
performs word-for-word substitution,
assembles the French translation, and
prints it out.
The function 'quicksort' rejects
duplicate entries (with 'error'/abort)
so that there is precisely one French
definition for any English word. Test
'quicksort' with both the original
'raw_data' and after having added
'("saves", "sauve")' to 'raw_data'.
Here is a von Neumann late-stopping
version of binary search. Make a
literal transliteration into Haskell.
Immediately upon entry, the Haskell
version must verify the recursive
"loop invariant", terminating with
'error'/abort if it fails to hold. It
also terminates in the same fashion if
the English word is not found.
function binsearch (x : integer) : integer
local j, k, h : integer
j,k := 1,n
do j+1 <> k --->
h := (j+k) div 2
{a[j] <= x < a[k]} // loop invariant
if x < a[h] ---> k := h
| x >= a[h] ---> j := h
fi
od
{a[j] <= x < a[j+1]} // termination assertion
found := x = a[j]
if found ---> return j
| not found ---> return 0
fi
In the Haskell version
binsearch :: String -> Integer -> Integer -> Entry
as the constant dictionary 'a' of type
'[Entry]' is globally visible. Hint:
Make your string (English word) into
an 'Entry' immediately upon entering
'binsearch'.
The programming value of the
high-level data type 'Entry' is that,
if you can design these two functions
over the integers, it is trivial to
lift them to to operate over Entry's.
Anybody know how I'm supposed to go about my binarysearch function?
The instructor asks for a "literal transliteration", so use the same variable names, in the same order. But note some differences:
the given version takes only 1
parameter, the signature he gives
requires 3. Hmmm,
the given version is not recursive, but he asks for a
recursive version.
Another answer says to convert to an Array, but for such a small exercise (this is homework after all), I felt we could pretend that lists are direct access. I just took your diction::[Entry] and indexed into that. I did have to convert between Int and Integer in a few places.
Minor nit: You've got a typo in your english value (bs is a shortcut to binSearch I made):
*Main> map bs (words english)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),*** Exception: Not found
*Main> map bs (words englishFixed)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),Entry ("saves","en vaut"),Entry ("nine.","cent.")]
*Main>
A binary search needs random access, which is not possible on a list. So, the first thing to do would probably be to convert the list to an Array (with listArray), and do the search on it.
here's my code for just the English part of the question (I tested it and it works perfectly) :
module Main where
class Lex a where
(<!), (=!), (>!) :: a -> a -> Bool
data Entry = Entry String String
instance Lex Entry where
(Entry a _) <! (Entry b _) = a < b
(Entry a _) =! (Entry b _) = a == b
(Entry a _) >! (Entry b _) = a > b
-- at this point, three binary (infix) operators on values of type 'Entry'
-- have been defined
type Raw = (String, String)
raw_data :: [Raw]
raw_data = [("than a", "qu'un"), ("saves", "en vaut"), ("time", "temps"),
("in", "<`a>"), ("worse", "pire"), ("{", "{"), ("A", "Un"),
("}", "}"), ("stitch", "point"), ("crime;", "crime,"),
("a", "une"), ("nine.", "cent."), ("It's", "C'est"),
("Zazie", "Zazie"), ("cat", "chat"), ("it's", "c'est"),
("raisin", "raisin sec"), ("mistake.", "faute."),
("blueberry", "myrtille"), ("luck", "chance"),
("bad", "mauvais")]
cook :: Raw -> Entry
cook (x, y) = Entry x y
a :: [Entry]
a = map cook raw_data
quicksort :: Lex a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort (filter (<! x) xs) ++ [x] ++ quicksort (filter (=! x) xs) ++ quicksort (filter (>! x) xs)
getfirst :: Entry -> String
getfirst (Entry x y) = x
getsecond :: Entry -> String
getsecond (Entry x y) = y
binarysearch :: String -> [Entry] -> Int -> Int -> String
binarysearch s e low high
| low > high = " NOT fOUND "
| getfirst ((e)!!(mid)) > s = binarysearch s (e) low (mid-1)
| getfirst ((e)!!(mid)) < s = binarysearch s (e) (mid+1) high
| otherwise = getsecond ((e)!!(mid))
where mid = (div (low+high) 2)
translator :: [String] -> [Entry] -> [String]
translator [] y = []
translator (x:xs) y = (binarysearch x y 0 ((length y)-1):translator xs y)
english :: String
english = "A stitch in time saves nine."
compute :: String -> [Entry] -> String
compute x y = unwords(translator (words (x)) y)
main = do
putStr (compute english (quicksort a))
An important Prelude operator is:
(!!) :: [a] -> Integer -> a
-- xs!!n returns the nth element of xs, starting at the left and
-- counting from 0.
Thus, [14,7,3]!!1 ~~> 7.

Resources