Is this what you want? (note that it does not preserve ordering, but neither does Map):

import Data.List
import Data.Function

noDups :: (Ord b, Num a) => [(a,b)] -> [(a,b)]
noDups = map sumGroup . groupBy ((==) `on` snd) . sortBy (compare `on` snd) where
  sumGroup xs = (sum $ map fst xs, snd $ head xs)

If you use the fact that the list has at most one value per currency, perhaps you should just keep the values in a map instead.

/J

On 7 June 2011 03:43, Tom Murphy <amindfv@gmail.com> wrote:
Hi All,
    This seems like an inefficient way to do what I'm trying to do.
I'd really appreciate any suggestions or comments:


import qualified Data.Map as Map

data Currency = Dollar
             | Yen
             | XP
             | Health
             | Street_Cred
             | Peso
   deriving (Show, Eq, Ord) -- why ord?

withDups = [(30, Dollar), (-20, Street_Cred), (-2, Dollar), (30, XP),
(15, Peso), (30, XP)]


flipAssoc (a, b) = (b, a)

noDups = Map.fromListWith (+) (map flipAssoc withDups)

final = map flipAssoc $ Map.toList noDups



Thanks for your time!
Tom

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners