[Haskell-cafe] Spine-lazy "multiqueue"

[Luke Palmer]

On Wed, Oct 22, 2008 at 3:14 AM, Ryan Ingram <ryani.spam at gmail.com> wrote:
> Here's an infinite structure with logarithmic access time with natural
> numbers for keys.
>
> It's not particularily efficient for a sparse map, but if the maximum
> used key is linear in the size of your problem, it gives log(n) access
> time.
>
> However, an infinite fold of insert is still _|_; you have to
> construct with "fromAscList" if you want to initialize the map with
> some infinite data.  This is because otherwise there is no way to know
> that we are "done" with the head of the map; some later value in the
> list might replace it.  The use of the ascending list lets us know
> after we've passed key n, we can construct the map up to at least n.

Well, actually the infinite fold of inserts is possible, since:

  lookup k (insert k x (insert k y)) = x

So the "earlier" one overwrites the "later" one in a right fold.

>
> *NatMap> lookup (fromAscList [(v,v) | v <- [0..]]) 42
> Just 42
>
>> module NatMap where
>> import Prelude hiding (lookup)
>
>> data NatMap v = NatMap (Maybe v) (NatMap v) (NatMap v)

Thanks for the ideas and inspiration everybody.  I was so locked into
the Ord constraint that I didn't see the obvious trie alternative.

I ended up going with something very similar to Ryan's suggestion.

  module NatTrie (NatTrie, uniform, modify, lookup, union) where

  import Prelude hiding (lookup)

  data NatTrie v = NatTrie { ntVal :: v,  nt0 :: NatTrie v, nt1 :: NatTrie v }

  uniform x = let r = NatTrie x r r in r

  modify = go . bits
    where
    go [] ~(NatTrie x l r) = NatTrie (f x) l r
    go (False:xs) ~(NatTrie x l r) = NatTrie x (go xs l) r
    go (True;xs) ~(NatTrie x l r) = NatTrie x l (go xs r)

  lookup = go . bits
    where
    go [] = ntVal
    go (False:xs) = go xs . nt0
    go (True:xs) = go xs . nt1

  union f (NatTrie x l r) (NatTrie x' l' r')
    = NatTrie (F x x') (union f l l') (union f r r')

  bits x
    | x < 0 = error "negative key"
    | otherwise = natBits x

  natBits 0 = []
  natBits x = toBool r : natBits q
    where
    (q,r) = quotRem x 2
    toBool = (== 1)

This does supports the infinite fold.  I put the main four operations
in class with a fundep for the key, but I'm not totally happy with it.
 In particular, I couldn't even write SumTrie (with Eithers as keys)
without undecidable instances.  Ideas for how to make such tries
composable would encourage me to release a hackage module :-)

Thanks everybody!

Luke