[Haskell-cafe] Grouping - Map / Reduce

Peter Verswyvelen bugfact at gmail.com
Thu Mar 26 19:37:01 EDT 2009


I'm also learning Haskell so the solution below might be (1) inefficient and
(2) incorrect, but hey, let's give it a try :-)
For simplicity, in the testing code, I assume an infinite list of key/value
pairs where they keys are of type Char between 'a' and 'z' and the values
are Integers (the code also seems to work for keys with just a lower bound
but no upper bound)

I think the code speaks for itself

 import System.Random

runningSumsOfValuesPerKey :: (Eq k, Num v) => [k] -> [(k, v)] -> [[v]]
runningSumsOfValuesPerKey allPossibleKeys = runningSums . allValuesPerKey
  where
    runningSums = map (scanl (+) 0)
    allValuesPerKey pairs = [ valuesWithKey key pairs | key <-
allPossibleKeys ]
    valuesWithKey key = map snd . filter ((==key) . fst)

-- Testing
randomPairs :: [(Char, Integer)]
randomPairs = zip keys values
  where
    keys        = randomRs ('a','z') rnd1
    values      = randomRs (0,9) rnd2
    (rnd1,rnd2) = split (mkStdGen 0)

test = map (take 10) [rs `atKey` 'c', rs `atKey` 'z']
  where
    rs = runningSumsOfValuesPerKey ['a'..] randomPairs
    xs `atKey` k = xs !! (fromEnum k - fromEnum 'a')
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090327/ef6043e9/attachment.htm


More information about the Haskell-Cafe mailing list