I’m trying to learn Haskell and I was trying to create a function that takes a list of lists and groups the sublist by equivalent sums. This is not homework.
import Data.List
let x = [[1,2],[2,1],[5,0],[0,3],[1,9]]
let groups = groupBy (\i j -> sum i == sum j) x
I get this output in GHCi:
[[[1,2],[2,1]],[[5,0]],[[0,3]],[[1,9]]]
I get [[1,2],[2,1]] grouping together, but not with [0,3]. Why is this?
I suspect I need to use map, but I can’t seem to make it work.
The groupBy function preserves the input order and is thus invertible. If you’re willing to throw away that information, you could use code along the lines of
import Data.List (foldl')
import Data.Map (elems,empty,insertWith')
bucketBy :: Ord b => (a -> b) -> [a] -> [[a]]
bucketBy eq = elems . foldl' go empty
where go m l = insertWith' (++) (eq l) [l] m
In action:
*Main> bucketBy sum x
[[[0,3],[2,1],[1,2]],[[5,0]],[[1,9]]]
How it works
The application of elems from Data.Map gives a clue for what’s happening.
elems :: Map κ α -> [α]
O(n). Return all elements of the map in the ascending order of their keys.
elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
elems empty == []
Mapping
A Map associates values of some type κ with values of another possibly distinct type α. In the example from your question, you start with x whose type is
*Main> :type x
x :: [[Integer]]
That is, x is a list of integer lists. The type of the resulting partition of x you want is
*Main> :t [[[0,3],[2,1],[1,2]],[[5,0]],[[1,9]]]
[[[0,3],[2,1],[1,2]],[[5,0]],[[1,9]]] :: Num τ => [[[τ]]]
or a list of lists where each of the latter lists are themselves lists that all have the same sum. The Num τ => bit is a context that constrains the type τ to be an instance of the typeclass Num. Happy for us, Integer is such a type:
*Main> :info Integer
data Integer
…
instance Num Integer -- Defined in GHC.Num
…
We know then that the type of the partition is [[[Integer]]]. This typeclass nonsense may seem unnecessarily fussy, but we’ll need the concept again in just a moment. (To give you an idea of what’s going on, the typechecker doesn’t have enough information to decide whether the literal 0, for example, is of type Int or Integer.)
Each sublist contains lists with the same sum. In other words, there exists a mapping from a sum to a list of integer lists. Therefore, the type of the Map used in bucketBy must resemble
Map Integer [[Integer]]
For example, with the sum 3 we associate the list
[ [0,3]
, [2,1]
, [1,2]
]
The fold recursion pattern
Folding is a highly general pattern. Left fold, foldl and friends in Haskell lets you “insert” an operator between elements of a list beginning with the zero value at the left end of the list. For example, the sum of [5,3,9,1] expressed as a left fold is
((((0 + 5) + 3) + 9) + 1)
or
foldl (+) 0 [5,3,9,1]
That is, beginning with a base value of zero, we successively add elements of the list and accumulate the sum.
Recall the definition of bucketBy contains
elems . foldl' go empty
This means the result of the left fold must be of type Map Integer [[Integer]], the zero value for our fold is the empty Map of that type, and go is somehow adding each successive value of a list into the map.
Note that foldl' is the strict cousin of foldl, but strictness is beyond the scope of this answer. (See also “Stack overflow” on HaskellWiki.)
Dude, where’s my list?
Given the type of foldl'
*Main> :t foldl'
foldl' :: (a -> b -> a) -> a -> [b] -> a
we should have three arguments in the application, but only two are present in the code above. This is because the code is written in point-free style. Your list is there implicitly due to partial application of foldl'.
Think back to the sum-as-fold example above. The type of that application without the final argument is
*Main> :t foldl (+) 0
foldl (+) 0 :: Num b => [b] -> b
Partial application allows us to create new functions. Here we defined a function that computes a number from some list of numbers. Hmm, sounds familiar.
*Main> :t sum
sum :: Num a => [a] -> a
The . combinator expresses function composition. Its name is chosen to resemble the notation g∘f as commonly seen in mathematics textbooks to mean “do f first and then compute g from the result.” This is exactly what’s happening in the definition of bucketBy: fold the list of values into a Map and then get the values of out the Map.
If ya gotta go, go with a smile
In your comment, you asked about the purpose of m. With an explicit type annotation, we might define go as
...
where go :: Map Integer [[Integer]] -> [Integer] -> Map Integer [[Integer]]
go m l = insertWith' (++) (eq l) [l] m
Matching variables with types, m is the Map we’ve accumulated so far, and l is the next Integer list that we want to toss into the appropriate bucket. Recall that eq is an argument to the outer bucketBy.
We can control how a new item goes into the map using insertWith'. (By convention, functions whose names end with trailing quotes are strict variants.)
The (++) combinator appends lists. The application eq l determines the appropriate bucket for l.
Had we written l rather than [l], the result would want to be
*Main> bucketBy sum x
[[0,3,2,1,1,2],[5,0],[1,9]]
but then we lose the structure of the innermost lists.
We’ve already constrained the type of bucketBy's result to be [[[α]]] and thus the type of the Map's elements. Say the next item l to fold is [1,2]. We want to append, (++), it to some other list of type [[Integer]], but the types don’t match.
*Main> [[0,3],[2,1]] ++ [1,2]
<interactive>:1:21:
No instance for (Num [t0])
arising from the literal `2'
Possible fix: add an instance declaration for (Num [t0])
In the expression: 2
In the second argument of `(++)', namely `[1, 2]'
In the expression: [[0, 3], [2, 1]] ++ [1, 2]
Wrapping l gets us
*Main> [[0,3],[2,1]] ++ [[1,2]]
[[0,3],[2,1],[1,2]]
Generalizing further
You might stop with
bucketBy :: ([Integer] -> Integer) -> [[Integer]] -> [[[Integer]]]
bucketBy eq = elems . foldl' go empty
where go m l = insertWith' (++) (eq l) [l] m
or even
bucketBy :: ([Integer] -> Integer) -> [[Integer]] -> [[[Integer]]]
bucketBy eq = elems . foldl' go empty
where go :: Map Integer [[Integer]] -> [Integer] -> Map Integer [[Integer]]
go m l = insertWith' (++) (eq l) [l] m
and be perfectly happy because it handles the case from your question.
Suppose down the road you have a different list y defined as
y :: [[Int]]
y = [[1,2],[2,1],[5,0],[0,3],[1,9]]
Even though the definition is very nearly identical to x, bucketBy is of no use with y.
*Main> bucketBy sum y
<interactive>:1:15:
Couldn't match expected type `Integer' with actual type `Int'
Expected type: [[Integer]]
Actual type: [[Int]]
In the second argument of `bucketBy', namely `y'
In the expression: bucketBy sum y
Let’s assume you can’t change the type of y for some reason. You might copy-and-paste to create another function, say bucketByInt, where the only change is replacing Integer with Int in the type annotations.
This would be highly, highly unsatisfying.
Maybe later you have some list of strings that you want to bucket according to the length of the longest string in each. In this imaginary paradise you could
*Main> bucketBy (maximum . map length) [["a","bc"],["d"],["ef","g"],["hijk"]]
[[["d"]],[["ef","g"],["a","bc"]],[["hijk"]]]
What you want is entirely reasonable: bucket some list of things using the given criterion. But alas
*Main> bucketBy (maximum . map length) [["a","bc"],["d"],["ef","g"],["hijk"]]
<interactive>:1:26:
Couldn't match expected type `Integer' with actual type `[a0]'
Expected type: Integer -> Integer
Actual type: [a0] -> Int
In the first argument of `map', namely `length'
In the second argument of `(.)', namely `map length'
Again, you may be tempted to write bucketByString, but by this point, you’re ready to move away and become a shoe cobbler.
The typechecker is your friend. Go back to your definition of bucketBy that’s specific to Integer lists, simply comment out the type annotation and ask its type.
*Main> :t bucketBy
bucketBy :: Ord k => (b -> k) -> [b] -> [[b]]
Now you can apply bucketBy for the different cases above and get the expected results. You were already in paradise but didn’t know it!
Now, in keeping with good style, you provide annotations for the toplevel definition of bucketBy to help the poor reader, perhaps yourself. Note that you must provide the Ord constraint due to the use of insertWith', whose type is
insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
You may want to be really explicit and give an annotation for the inner go, but this requires use of the scoped type variables extension.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.List (foldl')
import Data.Map (Map,elems,empty,insertWith')
bucketBy :: forall a b. Ord b => (a -> b) -> [a] -> [[a]]
bucketBy eq = elems . foldl' go empty
where go :: Map b [a] -> a -> Map b [a]
go m l = insertWith' (++) (eq l) [l] m
Without the extension and with a type annotation of
bucketBy :: Ord b => (a -> b) -> [a] -> [[a]]
the typechecker will fail with errors of the form
Could not deduce (b ~ b1)
from the context (Ord b)
bound by the type signature for
bucketBy :: Ord b => (a -> b) -> [a] -> [[a]]
at prog.hs:(10,1)-(12,46)
`b' is a rigid type variable bound by
the type signature for
bucketBy :: Ord b => (a -> b) -> [a] -> [[a]]
at prog.hs:10:1
`b1' is a rigid type variable bound by
the type signature for go :: Map b1 [a1] -> a1 -> Map b1 [a1]
at prog.hs:12:9
In the return type of a call of `eq'
In the second argument of `insertWith'', namely `(eq l)'
In the expression: insertWith' (++) (eq l) [l] m
This is because the typechecker treats the b on the inner type annotation as a distinct and entirely unrelated type b1 even though a human reader plainly sees the intent that they be the same type.
Read the scoped type variables documentation for details.
One last small surprise
You may wonder where the outer layer of brackets went. Notice that the type annotation generalized from
bucketBy :: ([Integer] -> Integer) -> [[Integer]] -> [[[Integer]]]
to
bucketBy :: forall a b. Ord b => (a -> b) -> [a] -> [[a]]
Note that [Integer] is itself another type, represented here as a.
groupBy splits the list into chunks of adjacent elements satisfying the given predicate. Since in your case, the [0,3] is separated from the [1,2] and [2,1], the first group includes only these. To collect all elements of the list having the same sum into one group, you need some preprocessing, e.g. with sortBy.
import Data.List
import Data.Function
import Data.Ord
groupBySum :: Num a => [[a]] -> [[[a]]]
groupBySum xss = groups
where
ys = map (\xs -> (sum xs,xs)) xss
sortedSums = sortBy (comparing fst) ys
groupedSums = groupBy ((==) `on` fst) sortedSums
groups = map (map snd) groupedSums
From hackage:
The group function takes a list and returns a list of lists such that the concatenation of the result is equal to the argument.
groupBy is the same, except that you can specify your equality test. Thus, since in your input list [0,3] is not adjacent to [1,2] or [2,1], it is put on its own.
Related
How can I get the union of an arbitrary number of lists in Haskell. For example, I would like a function that behaves like the one below:
example1 = union' [1,2,3] [1,4]
example2 = union' [1,2,3] [1,4] [2,6]
example1
[1,2,3,4]
example2
[1,2,3,4,6]
A function in Haskell only takes one argument. A "two"-argument function is really a function that returns another function that returns the ultimate return value. As such, there is no way for a function to take a variable number of arguments, because the return type of such a function wouldn't be well defined.
If you want to take the union of an arbitrary number of lists, your function should take a list of lists, since a list can contain an arbitrary number of elements.
union' :: Eq a => [[a]] -> [a]
union' = foldr unionOfTwo []
where unionOfTwo :: Eq a => [a] -> [a] -> [a]
unionOfTwo xs ys = ... -- left as an exercise
where unionOfTwo knows how to compute the union of exactly two lists. Effectively, union' sets aside the first list in the input, recursively computes the union of the remaining inputs, then computes the union of that result and the original first list. Put another way,
union' [] = []
union' (xs:xss) = unionOfTwo xs (union' xss)
First a working code example:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Main where
import Data.List (union)
class Unionable a t where
union' :: [a] -> t
instance Unionable a [a] where
union' = id
instance (Eq a, Unionable a t) => Unionable a ([a] -> t) where
union' xs ys = union' (union xs ys)
main = do
print $ (union' [1::Integer,2,3] [1::Integer,5,6] [1::Integer,7,3] :: [Integer])
mimiced from here.
You probably want to use such a function with literals and sadly, as you can see here, it will not be convienent to use it with polymorphic literals, as you will need to specify the type of every argument.
In other contexts, the types of the arguments have to be clear and the expected type of the result must be clear too, otherwise, you will need to add such type annotations.
For normal code it probably isn't worth the effort.
Let's explain what happens here, the compiler sees:
(union' [1::Integer,2,3] [1::Integer,5,6] [1::Integer,7,3] :: [Integer])
and it thinks, we need
union' :: [Integer] -> [Integer] -> [Integer] -> [Integer]
do we have such a union'? A candidate for that would be provided by the second instance declaration
a ~ Integer
t ~ [Integer] -> [Integer] -> [Integer]
but for that instance to be applicable, we need an instance of (Unionable a t) with those assignments. Do we have such an instance? Again the second instance declaration is a candidate, this time with
a ~ Integer
t ~ [Integer] -> [Integer]
but for that instance to be applicable, we need an instance of (Unionable a t) with those assignments. Do we have such an instance? Again the second instance declaration is a candidate, this time with
a ~ Integer
t ~ [Integer]
This time, we get such an instance from the first instance declaration with
no additional constraints needed.
This means (ommitting the type annotations for clarity)
union' [1,2,3] [1,5,6] [1,7,3]
= unions' (union [1,2,3] [1,5,6]) [1,7,3]
= unions' (union (union [1,2,3] [1,5,6]) [1,7,3])
= id (union (union [1,2,3] [1,5,6]) [1,7,3])
= (union (union [1,2,3] [1,5,6]) [1,7,3])
= [1,2,3,5,6,7]
I am reading the book "Programming in Haskell". One exercise asks me to define map f using an higher-order function. I choose to define map (+1) like the following:
unfold p h t x | p x = []
| otherwise = h x : unfold p h t (t x)
-- equivalent to `map (+1)`
mapinc = unfold (==[]) ((+1).head) tail
(Taken straight from the exercise question) The function unfold p h t produces the empty list if the predicate p is true of the argument value, and otherwise produces a non-empty list by applying the function h to this value to give the head, and the function t to generate another argument that is recursively processed in the same way to produce the tail of the list.
I have checked my implementation of mapinc and it looks fine:
*Main> mapinc [1,2,3]
[2,3,4]
However, after I add the type declaration:
mapinc :: Num a => [a] -> [a]
mapinc = unfold (==[]) ((+1).head) tail
Then reload the script in WinGHCi, it gives the following error:
• Could not deduce (Eq a) arising from a use of ‘==’
from the context: Num a
bound by the type signature for:
mapinc :: forall a. Num a => [a] -> [a]
at D:\7a.hs:4:1-29
Possible fix:
add (Eq a) to the context of
the type signature for:
mapinc :: forall a. Num a => [a] -> [a]
• In the first argument of ‘unfold’, namely ‘(== [])’
In the expression: unfold (== []) ((+ 1) . head) tail
In an equation for ‘mapinc’:
mapinc = unfold (== []) ((+ 1) . head) tail
|
5 | mapinc = unfold (==[]) ((+1).head) tail | ^^^^
Any clue why it happens?
Your signature is too broad. The predicate you have written is == []. Haskell can only check if two lists are equal, if the elements of the list can be checked as well. In the source code we see something like:
instance Eq a => Eq [a] where
...
Yes, here we will never check the equality of two items, since we check with the empty list, but the compiler of course does not know that: it simply sees that in order to check whether two lists are equal, we need to be able to check if elements are equal.
The Num typeclass does not imply that the type is also an Eq type. We can do two things here:
add the Eq type constraint to the signature:
mapinc :: (Eq a, Num a) => [a] -> [a]
mapinc = unfold (==[]) ((+1).head) tail
more elegant: do not rely on the fact that we need to be able to compare elements, but use null :: [a] -> Bool instead (a function that checks if the list is empty):
mapinc :: Num a => [a] -> [a]
mapinc = unfold null ((+1).head) tail
I've just started programming in Haskell, and I am solving 99 Haskell problems, and when I was nearly done with 10th, I've encountered this problem:
-- Exercise 9
pack :: Eq a => [a] -> [[a]]
pack [] = []
pack list = let (left,right) = span (== head list) list in
left : pack right
-- Exercise 10
encode :: (Eq a, Integral c) => [a] -> [(c, a)]
encode [] = []
encode list = map (\x -> (length x, head x)) (pack list)
-- this doesn't work ^^^^^^^^
The error produced told me that
Could not deduce (c ~ Int)
from the context (Eq a, Integral c)
bound by the type signature for
encode :: (Eq a, Integral c) => [a] -> [(c, a)]
at C:\fakepath\ex.hs:6:11-47
`c' is a rigid type variable bound by
the type signature for
encode :: (Eq a, Integral c) => [a] -> [(c, a)]
at C:\fakepath\ex.hs:6:11
In the return type of a call of `length'
In the expression: length x
In the expression: (length x, head x)
I've managed to fix that by inserting a function I've read about in Learn you a Haskell: fromIntegral.
encode list = map (\x -> (fromIntegral $ length x, head x)) (pack list)
So, my question is, why is that needed?
I've run :t length and got [a] -> Int, which is a pretty defined type for me, which should satisfy Integral c constraint.
The type signature (Eq a, Integral c) => [a] -> [(c, a)] means the function works for any types a and c in the appropriate typeclasses. The actual type used is specified at the call site.
As a simple example, let's take a look at the type of the empty list:
:t []
[a]
What this means is that [] represents an empty list of String, and empty list of Int, an empty list of Maybe [Maybe Bool] and whatever other types you can imagine. We can imagine wrapping this in a normal identifier:
empty :: [a]
empty = []
empty obviously works the same way as []. So you can see that the following definition would make no sense:
empty :: [a]
empty = [True]
after all, [True] can never be a [Int] or [String] or whatever other empty list you want.
The idea here is the same, except we have typeclass constraints on the variables as well. For example, you can use encode to return a [(Integer, String)] list because Integer is also in the Integral class.
So you have to return something polymorphic that could be any Integral--just what fromIntegral does. If you just returned Int, encode would only be usable as an Int and not any Integral.
When using the interactive GHC interpreter, it's possible to ask for the inferred type of an expression:
Prelude> :t map
map :: (a -> b) -> [a] -> [b]
It seems that it takes the names of the type variables from the signature since map is defined as
map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs
in the Prelude. That makes a lot of sense! My question is: how are type variable names picked when there is no signature given?
An example would be
Prelude> :t map fst
map fst :: [(b, b1)] -> [b]
where it picked names b and b1. It's clear that renaming must take place, but simply starting with a, b, ... would have given
map fst :: [(a, b)] -> [a]
instead, which I find slightly more readable.
As I understand it, ghci chooses names in the same order that it infers the types. It uses the naming scheme as you mentioned to decide the type name of the result, which is [b] because that is the type name specified in the definition of map. It then decides that the function that is the first parameter to map should return something of type b also.
The remaining type variable to be named is thus the type variable for the second element in the argument tuple to fst, and again, it looks at the definition of fst to decide which name to use. The definition of fst :: (a, b) -> a, so b would be the preferred name here, but since b is already taken, it appends a 1 so that it becomes b1.
I think that this system has advantages in situations where you don't deal with arbitrary types as is the case here. If the resulting type looks something like this, for example:
castAdd :: (Num n, Num n1, Num n2) => n -> n1 -> n2
... it is arguably more readable than:
castAdd :: (Num a, Num b, Num c) => a -> b -> c
... because you can mostly rely on that n# signifies a numeric type, since the class definition for Num is class Num n where ....
EDIT: Yes, I know that castAdd is impossible to implement, but it's just a type example.
So I'm playing around with this:
factors :: Integral a => a -> [a]
factors n = filter (\d -> n `rem` d == 0) . takeWhile (\d -> d*d <= n) $ [ 1 .. ]
abundants_perfects_deficients :: Integral a => ([a],[a],[a])
abundants_perfects_deficients = foldr switch ([],[],[]) [1..]
where switch :: Integral a => a -> ([a],[a],[a]) -> ([a],[a],[a])
switch n (as,ps,ds) =
let t = sum (factors n) in
if t < n then (as,ps,n:ds)
else if t == n then (as,n:ps,ds)
else (n:as,ps,ds)
And while I've got abundants_perfects_deficients, I'd rather have three values: abundants, perfects, and deficients all of type Integral a -> [a].
One thing that doesn't work is:
abundants,perfects,deficients :: Integral a => [a]
(abundants,perfects,deficients) = abundants_perfects_deficients
Because this constrains the three to all be over the same a.
I tried something to do them one-by-one, so they wouldn't mutually constrain, but that didn't work either:
perfects :: Integral a => [a]
(_,perfects,_) = abundants_perfects_deficients
Because the compiler couldn't figure out how to convert a value of type forall a. Integral a => ([a],[a],[a]) to type (t1, forall a. Integral a => [a], t2).
Which seems cromulent enough.
Now I know I could implement them separately (just perfects = filter isPerfect [1..]), or constrain them to all be of the same type ((abundants,perfects,deficients) = abundants_perfects_deficients works fine if abundants,perfects,deficients :: [Integer]), but
I like using the shared information to build all three
I want to not just be constrained to Integers
ideas?
Edit: Fascinatingly enough this works:
abundants :: Integral a => [a]
abundants = f as
where as :: [Integer]
(as,_,_) = abundants_perfects_deficients
f :: Integral a => [Integer] -> [a]
f = map fromInteger
But this doesn't:
abundants_perfects_deficients' :: (Integral a,Integral p, Integral d) => ([a],[p],[d])
abundants_perfects_deficients' = (f as, f ps, f ds)
where as,ps,ds :: [Integer]
(as,ps,ds) = abundants_perfects_deficients
f :: Integral a => [Integer] -> [a]
f = map fromInteger
abundants,perfects,deficients :: (Integral a) => [a]
(abundants,perfects,deficients) = abundants_perfects_deficients'
I have no idea why.
This relates to what polymorphic types really mean, which is slightly more complicated than how they first appear.
At this point it's probably easier to switch modes of thinking and look at the quantifier as being a form of lambda abstraction: A type like ∀ a. [a] is thus a function taking a single type argument, and returning a list of things of that type. Class constraints like Integral a can be seen as additional arguments (specifically, the instance dictionary) which are implicitly provided when GHC finds the values for you.
To emphasize the point, I'm going to write the quantifiers as /\ a -> to mimic lambda syntax, and write class constraints as regular arguments.
Written this way, the type of abundants_perfects_deficients is /\a -> Integral a -> ([a],[a],[a]), and your initial attempt failed essentially because you were trying to pattern match on the result of a two-argument function. In many cases GHC automagically shuffles these implicit arguments around to make things work out, but here it quite clearly can't--to get any result from abundants_perfects_deficients you first need to apply it to both arguments, getting a monomorphic result, which is then bound using the pattern. Even when the pattern binds only one value, the rest being _, GHC still needs to type-check the pattern binding itself, so even though it seems like the extra arguments could be floated out to the single bound identifier, this fails for the same reason as binding all three at once.
To bind three polymorphic values with a pattern, you would instead need the extra arguments to be on the inside, giving abundants_perfects_deficients a type like (/\a -> Integral a -> [a], /\a -> Integral a -> [a], /\a -> Integral a -> [a]). This requires the ImpredicativeTypes extension, which has a somewhat checkered past, and which I'm still wary of.
A lot of what's tripping you up here is that GHC isn't clever enough to figure out "obvious" things, like floating implicit type and constraint arguments based on only being used within a particular part of a binding. Given how much magic it already does behind the scenes, this doesn't bother me too much. :]
The simplest solution is to just bind all three separately, using a selection function to extract the individual elements. This lets the top-level binding be polymorphic in the expected way, with the implicit arguments it receives implicitly passed along to abundants_perfects_deficients, and the projection function simply discarding the other three after a (now monomorphic) pattern match.
abundants,perfects,deficients :: Integral a => [a]
(abundants,perfects,deficients) = abundants_perfects_deficients
Try:
fst3 (a,_,_) = a
snd3 (_,a,_) = a
thd3 (_,_,a) = a
abundants,perfects,deficients :: Integral a => [a]
abundants = fst3 . abundants_perfects_deficients
perfects = snd3 . abundants_perfects_deficients
deficients = thd3 . abundants_perfects_deficients
fromIntegral might be useful:
Prelude> :t fromIntegral
fromIntegral :: (Num b, Integral a) => a -> b
Probably slightly offtopic, but anyway.
Your factors function is wrong (try to compute factors 28 ;)
Here's a different approach to the problem:
classifieds = map (\n -> (n, compare n (sum $ factors n))) [1..]
perfects = map fst $ filter ((== EQ) . snd) classifieds
abundants = map fst $ filter ((== GT) . snd) classifieds
deficients = map fst $ filter ((== LT) . snd) classifieds