[Haskell] combining IntMaps

[Adrian Hey]

On Wednesday 20 Jul 2005 4:05 am, Scherrer, Chad wrote:
> I'm using the (IntMap Int) type to implement functions (Int -> Int), by
> treating non-keys as values that map to zero. I'd like to be able to add
> two of these pointwise, and delete the key from the resulting map when
> the sum of the values is zero. My specification is
>
> addMaps :: IntMap Int -> IntMap Int -> IntMap Int
> addMaps m = IntMap.filter (/= 0) . IntMap.unionWith (+) m
>
> But I'm not really happy with this because it traverses both maps for
> the union, and then traverses the result to get rid of all the zeros.
> (This function is a performance bottleneck in my current code).

Examples like this are interesting because they show just how difficult
it is produce a comprehensive library for even one common or garden data
structure. I thought my AVL library was reasonably complete when I
released it, but I've subsequently thought of plenty of stuff that's
still missing (arguably), and you've just given me more.

Anyway, you might like to try using AVL trees which I have just upgraded
to provide the necessary functions..
 http://homepages.nildram.co.uk/~ahey/HLibs/Data.Tree.AVL/

You should be able to produce a reasonable alternative to Data.IntMap
with this. I'd be interested to know how it performs. I won't do
the whole thing myself, but here's a start (uses GHCs unboxed Ints).

{-# OPTIONS -fglasgow-exts #-}

import Data.COrdering
import Data.Tree.AVL
import GHC.Base

data IntAssoc = IntAssoc Int# Int# --Perhaps use boxed values instead??
newtype IMap = IMap (AVL IntAssoc)

emptyIMap :: IMap
emptyIMap = IMap empty

lookUp :: IMap -> Int -> Int
lookUp (IMap avl) (I# skey)  = genReadDefault 0 avl cmp
 where cmp (IntAssoc key v) = case compareInt# skey key of
                              LT -> Lt
                              EQ -> Eq (I# v)
                              GT -> Gt

set :: Int -> Int -> IMap -> IMap
set (I# k) (I# v) (IMap avl) = IMap avl'
 where avl' = if v ==# 0# then genDel cmp avl
                          else genPush ccmp ia avl
       ia = IntAssoc k v
       cmp  (IntAssoc k' _) = compareInt# k k'
       ccmp (IntAssoc k' _) = case compareInt# k k' of
                              LT -> Lt
                              EQ -> Eq ia
                              GT -> Gt

addMaps :: IMap -> IMap -> IMap
addMaps (IMap avl0) (IMap avl1) = IMap (genUnionMaybe ccmp avl0 avl1)
 where ccmp (IntAssoc k0 v0) (IntAssoc k1 v1) =
        case compareInt# k0 k1 of
             LT -> Lt
             EQ -> let s = v0 +# v1 
                   in if s ==# 0# then Eq Nothing
                                  else Eq (Just (IntAssoc k0 s))
             GT -> Gt

Regards
--
Adrian Hey