[Haskell-cafe] Spine-lazy "multiqueue"

[Timothy Goddard]

On Wed, 22 Oct 2008 11:54:50 Luke Palmer wrote:
> On Tue, Oct 21, 2008 at 3:02 PM, Justin Bailey <jgbailey at gmail.com> wrote:
> > On Tue, Oct 21, 2008 at 11:43 AM, Luke Palmer <lrpalmer at gmail.com> wrote:
> >> Hi, I need a rather strange data structure, and I can't find any
> >> existing implementations or think of a way to implement it.  It's a
> >> "multiqueue", basically a map of queues.  The trick is that it should
> >> be lazy in its spine and still support efficient access.  For example,
> >> the following should hold:
> >
> > This doesn't answer your question, but how is a Map of queues not
> > "spine-lazy"? I'm mostly looking to understand that term.
>
> Well, first, my question was highly malformed.  I actually just want a
> spine lazy map of lists; queues were not what I wanted.
>
> Data.Map is strict in its keys, meaning rougly that you cannot store
> infinitely many keys in a map.  So:
>
>   foldr (\x x -> Map.insert x x) Map.empty [0..]  =  _|_
>
> I.e. if you take this map that maps every natural to itself and try to
> do anything with it, you will get an infinite loop (or stack overflow,
> or whatever).
>
> On the other hand, the "map" type [(k,v)] *is* spine lazy, because, for
> example:
>
>   lookup 42 [ (x,x) | x <- [0..] ]  = Just 42
>
> It's just not very efficient.  I'm basically looking for a version of
> the above which has a logarithmic lookup time.
>
> The best I've come up with so far is a binary search tree where the
> most recently inserted thing is at the root.  It's not balanced,
> because balancing would make it strict (as far as I can tell).  So
> it's only logarithmic time sometimes.
>
> Luke
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe

You might possibly be able to get a logarithmic lookup time for keys known to 
be present while preserving some laziness (don't ask me how) but to say a key 
does not exist in the map you would have to somehow check them all, which 
with an infinite list of keys will never complete.

You're unlikely to get a free lunch with infinite maps - infinite items means 
infinite depth to any tree structure and there are few other nice 
alternatives.

You could simply add your own laziness - have a special map which consumes a 
list of (key, value) pairs and where reading the map also returns another map 
evaluated enough to answer the immediate query. Reading an already discovered 
key will take logarithmic time while reading an undiscovered key will take as 
long as it takes to find it in the list (for a nonexistent key, until memory 
runs out).

You could also work carefully with mutable references inside the map to make 
it appear pure from the outside. It could still present a referentially 
transparent interface since it is only evaluating itself further, not 
changing what it actually contains. You would have to make sure this worked 
properly though.

With that map you could perform updates as normal. Reading a value from the 
input list that already exists in the map would just do nothing.

I was interested enough to give this a try. Source is attached. It's 
incomplete - if you finish it please send me the result. Otherwise, use as 
you like.

Cheers,

Tim
-------------- next part --------------
module InfiniteMap
  (
    InfiniteMap,
    fromList,
    (!)
  )
  where

import System.IO.Unsafe
import Data.IORef
import qualified Data.Map as M

data InfiniteMap k v = InfiniteMap {imRef :: IORef ((M.Map k v), [(k, v)])}

fromList :: Ord k => [(k, v)] -> InfiniteMap k v
fromList l = InfiniteMap (unsafePerformIO $ newIORef (M.empty, l))

fillMapUntil :: (Ord k, Eq k) => k -> (M.Map k v, [(k, v)]) -> (M.Map k v, [(k, v)])
fillMapUntil tk (m, []) = (m, [])
fillMapUntil tk (m, ((k, v):xs))
  | tk == k = (filledMap, xs)
  | otherwise = fillMapUntil tk (filledMap, xs)
  where
    filledMap = M.insertWith' (\a _ -> a) k v m

(!) :: Ord k => InfiniteMap k v -> k -> v
m ! k = if k `M.member` cmap then (M.!) cmap k else (if k `M.member` newMap then (M.!) newMap k else error "Key not in map")
  where
    cmap = fst $ unsafePerformIO $ readIORef $ imRef m
    newMap = unsafePerformIO $ do
      (nm, nl) <- atomicModifyIORef (imRef m) (\a -> let res = fillMapUntil k a in (res, res))
      return nm

insert :: Ord k => k -> v -> InfiniteMap k v -> InfiniteMap k v
insert k v m = InfiniteMap $ unsafePerformIO $ newIORef (M.insert k v cmap, clist)
  where
    (cmap, clist) = unsafePerformIO $ readIORef $ imRef m