I'm trying to do one of the Monoid exercises in Haskell Book (Chapter 15, "Monoid, Semigroup") but I'm stuck. The following is given:
newtype Combine a b =
Combine { unCombine :: (a -> b) }
and I'm supposed to write the Monoid instance for Combine.
I wrote something like this:
instance (Semigroup b) => Semigroup (Combine a b) where
Combine { unCombine = f } <> Combine { unCombine = g } =
Combine { unCombine = \x -> f x <> g x }
instance (Monoid b) => Monoid (Combine a b) where
mempty = Combine { unCombine = \_ -> mempty }
mappend = (<>)
but I do not know how to write the quickCheck for the instance.
Here is my try (does not compile):
monoidLeftIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity1 x = mappend mempty x == x
monoidRightIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity1 x = mappend x mempty == x
main :: IO ()
main = do
quickCheck (monoidLeftIdentity1 :: Combine Int (Sum Int) -> Bool)
quickCheck (monoidRightIdentity1 :: Combine Int (Sum Int) -> Bool)
It seems I must instance Arbitrary and Eq on this type, but how to write them for a function?
There is a similar question, in that question, we are asked to write the Semigroup instance for Combine.
First a full code example:
module Main where
import Test.QuickCheck
import Data.Monoid
newtype Combine a b = Combine { unCombine :: a -> b }
instance (Semigroup b) => Semigroup (Combine a b) where
a <> _ = a
-- (Combine f) <> (Combine g) = Combine $ \a -> (f a) <> (g a)
instance (Monoid b) => Monoid (Combine a b) where
mempty = Combine $ \_ -> mempty
monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity m = mappend mempty m == m
monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity m = mappend m mempty == m
monoidLeftIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidLeftIdentityF wrap eval point candidate = eval (mappend mempty m) point == eval m point
where m = wrap candidate
monoidRightIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidRightIdentityF wrap eval point candidate = eval (mappend m mempty) point == eval m point
where m = wrap candidate
main :: IO ()
main = do
quickCheck $ (monoidLeftIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
quickCheck $ (monoidRightIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
What are we doing here?
First we need a way to generate random functions. That is, what this Fun thing is about. There is an Arbitrary instance for Fun a b, if there are certain instances available for a and b. But most of the time we have those.
A value of type Fun a b can be shown, so Fun a b has a show instance, provided a and b have one. We can extract the function with applyFun.
For QuickCheck to take advantage of this, we need to provide a Testable where all argument positions can be randomly generated and shown.
So we have to formulate our Properties in terms of a, b and Fun a b.
To connect all of this with Combine we provide a function from Fun a b to Combine a b.
Now we are stuck with another problem. We can't compare functions, so we can't compare values of type Combine a b for equality. As we are already randomly generating test cases, why not just generate the points, on which to test the functions for equality, also randomly. The equality will not be a sure thing, but we are hunting the falsifiable examples! So that is good enough for us. To do that, we provide a function to "apply" a value of type Combine a b to a value of type a, to get a value of type b, which can hopefully be compared for equality.
You can use Test.QuickCheck.Function to generate random function values, so you should be able to write something like the following to take care of the Arbitrary constraint:
quickCheck (monoidLeftIdentity1 . Combine . apply :: Fun Int (Sum Int) -> Bool)
For the Eq constraint, however, you will have trouble comparing function values. I think it should be enough to just check pointwise equality for some sampling of inputs, e.g.
funoidLeftIdentity1 :: (Monoid b, Eq b) => Fun a b -> a -> Bool
funoidLeftIdentity1 (Fn f) x = uncombine (Combine f <> mempty) x == uncombine mempty x
Related
I am new to Haskell, I am trying to write a test case to prove the associative law for Semigroup typeclass.
The data type define as followed:
newtype Combine a b = Combine {unCombine :: (a -> b)}
The implementation of Semigroup as followed:
instance (Semigroup b) => Semigroup (Combine a b) where
(Combine f) <> (Combine g) = Combine (\x -> f x <> g x)
I already wrote a associative test function
assocTestFunc :: (Eq m, Semigroup m) => m -> m -> m -> Bool
assocTestFunc a b c = (a <> b) <> c == a <> (b <> c)
and also defined a type alias like this:
type CombineAssoc = Combine String Ordering -> Combine String Ordering -> Combine String Ordering -> Bool
So in my main function, I can test it like this:
quickCheck (assocTestFunc :: CombineAssoc)
However I am having a hard time to implement the Arbitrary instance for the Combine a b data type.
Thanks advance for any help.
You can exploit the predefined instance for functions.
instance (CoArbitrary a, Arbitrary b) => Arbitrary(Combine a b) where
arbitrary = Combine <$> arbitrary
I am trying to implement my own functor instances and quickcheck them, and have run into issues on typeclasses which are not instances of Eq, namely (->) and IO. My attempts result in a No instance for (Eq ...) error.
In the (->) case I had run into a similar error with Show, i.e. No instance for (Show ...), and was able to fix that by adding a Show (a -> b) instance as suggested in an answer here. It would seem that I might be able to solve also the lack of Eq instances by adding them similarly. However, this question on function equality notes that that in Haskell creating an instance of Eq (a -> b) is equivalent to the halting problem and therefore impossible.
I'm not sure whether creating an instance of Eq IO a is possible. In the IO case I also run into a No instance for (Arbitrary ...) error.
Is there some way to quickcheck the functor properties of the function type (->)? Is there some way to do the same for the IO type?
My code is as follows.
import Prelude hiding (Functor, fmap)
import Test.QuickCheck
import Test.QuickCheck.Function
class Functor f where
fmap :: (a -> b) -> f a -> f b
instance Functor IO where
fmap h f = f >>= (pure . h)
instance Functor ((->) e) where
fmap = (.)
data T a = T
prop_functorid :: (Functor f, Eq (f a)) => T (f a) -> f a -> Bool
prop_functorid T x = fmap id x == x
prop_functorcompose :: (Functor f, Eq (f c)) => T (f a) -> T b -> T c -> f a -> Fun a b -> Fun b c -> Bool
prop_functorcompose T T T x (apply -> g) (apply -> h) =
fmap (h . g) x == (fmap h . fmap g) x
instance Show (a -> b) where
show a= "function"
prop_function :: IO ()
prop_function = do
quickCheck $ prop_functorid (T :: T (String -> String))
quickCheck $ prop_functorcompose (T :: T (String -> String)) (T :: T String) (T :: T String)
prop_io :: IO ()
prop_io = do
quickCheck $ prop_functorid (T :: T (IO String))
quickCheck $ prop_functorcompose (T :: T (IO String)) (T :: T String) (T :: T String)
main = do
prop_function
prop_io
I'm trying to solve the same exercise as this other question in Chapter 15 of "Haskell Programming from First Principles". I've already made a Semigroup instance, and I'm having trouble writing the QuickCheck part of the exercise.
A Semigroup instance should satisfy:
a <> (b <> c) == (a <> b) <> c
where <> is the Semigroup mappend.
I have come up with the following:
import Data.Semigroup
import Test.QuickCheck
semigroupAssoc :: (Eq m, Semigroup m) => m -> m -> m -> Bool
semigroupAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c)
newtype Combine a b = Combine { unCombine :: (a -> b) }
instance Semigroup b => Semigroup (Combine a b) where
(Combine f) <> (Combine g) = Combine (\x -> (f x) <> (g x))
instance CoArbitrary (Combine a b) where
coarbitrary (Combine f) = variant 0
instance (CoArbitrary a, Arbitrary b) => Arbitrary (Combine a b) where
arbitrary = do
f <- arbitrary
return $ Combine f
type CombineAssoc a b = Combine a b -> Combine a b -> Combine a b -> Bool
main :: IO ()
main = do
quickCheck (semigroupAssoc :: CombineAssoc Int Bool)
Everything compiles except for the quickCheck line, where it complains that there is No instance for (Eq (Combine Int Bool)) arising from a use of ‘semigroupAssoc’.
I don't think there is a way to test if two arbitrary function are equal (the functions wrapped up by Combine), but the exercise text suggests that such a thing is possible.
Any ideas on how I could make this work?
EDIT:
The authors give a hint for this exercise:
Hint: This function will eventually be applied to a single value
of type a. But you’ll have multiple functions that can produce a
value of type b. How do we combine multiple values so we have
a single b? This one will probably be tricky! Remember that the
type of the value inside of Combine is that of a function. If you
can’t figure out CoArbitrary, don’t worry about QuickChecking
this one.
#Li-yao Xia's answer seems to be the best answer. But shouldn't I use this CoArbitrary instance for something?
You can't decide whether two functions are equal. But you can test it!
Two functions are equal if and only if for any input they give the same output. This is a testable property: generate some inputs, compare the outputs. If they are different, you've got a counter-example.
-- Test.QuickCheck.(===) requires (Eq b, Show b)
-- but you can use (==) if you prefer.
funEquality :: (Arbitrary a, Show a, Eq b, Show b) => Combine a b -> Combine a b -> Property
funEquality (Combine f) (Combine g) =
property $ \a -> f a === g a
Notice that the Bool result in the type of "decidable equality" (==) :: X -> X -> Bool is replaced with Property in what we might call "testable equality" funEquality :: X -> X -> Property. It's actually not necessary to use property and convert the function a -> Property (or a -> Bool if you use (==)) to Property, but the types look neater that way.
We need to rewrite the function corresponding to the associativity property, since we no longer rely on Eq.
type CombineAssoc a b = Combine a b -> Combine a b -> Combine a b -> Property
combineAssoc :: (Arbitrary a, Show a, Eq b, Show b, Semigroup b) => CombineAssoc a b
combineAssoc f g h = ((f <> g) <> h) `funEquality` (f <> (g <> h))
Edit: at this point we're actually still missing a Show instance for Combine. QuickCheck provides a wrapper Fun to both generate and show functions as counterexamples.
main = quickCheck $ \(Fn f) (Fn g) (Fn h) ->
(combineAssoc :: CombineAssoc Int Bool) (Combine f) (Combine g) (Combine h)
Indeed it is not possible or at least not feasible, however you don't really need a test case with such a big argument type as Int!
For smaller types, e.g. Int16, you can just exhaustively try all possible arguments to determine equality. The universe package has a convenient class for that:
import Data.Universe
instance (Universe a, Eq b) => Eq (Combine a b) where
Combine f == Combine g = all (\x -> f x == g x) universe
Then your original check will work, albeit unacceptably slow; I'd recommend changing it to quickCheck (semigroupAssoc :: CombineAssoc Int16 Bool).
I am trying to write my own foldMap function as an excersice to learn Haskell
Currently it looks like this
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold (<>) mempty (fmap g a)
However when compiling it it gives the following error
Could not deduce (Monoid ((f m -> m) -> fm -> m)) arising from use of 'fold'
from the context (Foldable f) bound by the class declaration for 'Foldable' at (file location)
or from (Monoid m) bound by the type signature for foldMap :: Monoid m => (a -> m) -> f a -> m at (file location
In the expression fold (<>) mempty (fmap g a)
In an equation for 'foldMap':
foldMap g a = fold (<>) mempty (fmap g a)
I can't figure out what the compiler is trying to tell me with this error, can anyone tell me what goes wrong with my foldMap?
Maybe we should do an answer with the actual solution:
I hope it's now clear, that this is a possible definition:
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
follow the types
Andrew and Lee already gave you a high level explanation but maybe I can give you another view on it:
Let's just follow the types to oget to this answer:
We want a function f a -> m where m is a monoid and f is a functor. In addition we have a function g :: a -> m we can use to get from some a into the monoid - nice.
Now we get some additional functions:
fold :: f m -> m from our own class
fmap :: (a -> b) -> f a -> f b from the Functor f
Ok we need f a -> m now if only the a would be an m then we could use fold ... dang.
But wait: we can make a a into a m using g- but the a is packed into f ... dang.
Oh wait: we can make a f a into a f m using fmap .... ding-ding-ding
So let's do it:
make f a into f m: fmap g a
use fold on it: fold (fmap g a)
or using $:
foldMap g a = fold $ fmap g a
example
Let's get something so we can try:
module Foldable where
import Data.Monoid
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
instance Foldable [] where
fold [] = mempty
fold (x:xs) = mappend x (fold xs)
here is a simple example using this with Sum and [1..4]:
λ> foldMap Sum [1..4]
Sum {getSum = 10}
which seems fine to me.
A Monoid has two functions, mappend and mempty, and you can use (<>) in place of mappend.
Typeclasses work because the compiler inserts the appropriate definition for the function depending on the types of the data, so (happily) there's no need to pass around the function in question.
The mistake you've made is to unnecessarily pass the Monoid functions you're using in.
For example, if I defined a function to test if something was in a list like this:
isin :: Eq a => a -> [a] -> Bool
isin equalityFunction a list = any (equalityFunction a) list
I'd have unnecessarily tried to pass the equalityFunction as an argument, and the type signature doesn't match it.
Instead I should define
isin :: Eq a => a -> [a] -> Bool
isin a list = any (== a) list
using the standard name for the equality function as defined in the Eq typeclass.
Similarly, you neither need nor should pass the (<>) or empty arguments.
I want to create a function A -> Bool using some lenses of A. For instance:
data A = A { _foo :: Int, _bar :: Int }
makeLenses ''A
l :: [A]
l' = filter (\a -> a^.foo > 100) l
The filter predicate looks a bit clumpsy. ((>100).(^.foo)) is not much better. Without lenses, I would use ((>100) . foo).
Is there a nice way to create such predicates with lens? Ideally it would also allow predicates like (\a -> a^.foo > 100 && a^.bar < 50).
I think ((>100).(^.foo)) is probably the best you can do with just using the standard operators. If you are willing to define new comparison operators for lenses, you could do something like:
import Control.Lens hiding ((.>))
import Control.Monad (liftM2)
import Control.Monad.Reader (MonadReader)
import Data.Function (on)
(.==) :: (MonadReader s m, Eq a) => Getting Bool s a -> a -> m Bool
(.==) l = views l . (==)
infix 4 .==
(.==.) :: (MonadReader s m, Eq a) => Getting a s a -> Getting a s a -> m Bool
(.==.) = liftM2 (==) `on` view
infix 4 .==.
(.<) :: (MonadReader s m, Ord a) => Getting Bool s a -> a -> m Bool
(.<) l = views l . flip (<)
infix 4 .<
(.<.) :: (MonadReader s m, Ord a) => Getting a s a -> Getting a s a -> m Bool
(.<.) = liftM2 (<) `on` view
infix 4 .<.
(.<=) :: (MonadReader s m, Ord a) => Getting Bool s a -> a -> m Bool
(.<=) l = views l . flip (<=)
infix 4 .<=
(.<=.) :: (MonadReader s m, Ord a) => Getting a s a -> Getting a s a -> m Bool
(.<=.) = liftM2 (<=) `on` view
infix 4 .<=.
(.>) :: (MonadReader s m, Ord a) => Getting Bool s a -> a -> m Bool
(.>) l = views l . flip (>)
infix 4 .>
(.>.) :: (MonadReader s m, Ord a) => Getting a s a -> Getting a s a -> m Bool
(.>.) = liftM2 (>) `on` view
infix 4 .>.
(.>=) :: (MonadReader s m, Ord a) => Getting Bool s a -> a -> m Bool
(.>=) l = views l . flip (>=)
infix 4 .>=
(.>=.) :: (MonadReader s m, Ord a) => Getting a s a -> Getting a s a -> m Bool
(.>=.) = liftM2 (>=) `on` view
infix 4 .>=.
(.&&.) :: Monad m => m Bool -> m Bool -> m Bool
(.&&.) = liftM2 (&&)
infix 3 .&&.
(.||.) :: Monad m => m Bool -> m Bool -> m Bool
(.||.) = liftM2 (||)
infix 3 .||.
The logic behind the operator choices is that the dot signifies the side that has a lens, so you could write either foo .== 5 or foo .==. bar (where foo and bar are lenses). Unfortunately, the lens package also defines its own (.<) operator, so maybe some other naming convention would be better. This was just the first idea that came to my mind.
Using these new operators, you would be able to write stuff like
l' = filter (foo .> 100 .&&. bar .< 50) l