[Haskell-cafe] ONeillPrimes.hs - priority queue broken?

[Eugene Kirpichov]

Hi,
I've recently tried to use the priority queue from the
ONeillPrimes.hs, which is famous for being a very fast prime
generator: actually, I translated the code to Scheme and dropped the
values, to end up with a key-only heap implementation.
However, the code didn't work quite well, and I decided to check the
haskell code itself.

Turns out that it is broken.

module PQ where

import Test.QuickCheck

data PriorityQ k v = Lf
                   | Br {-# UNPACK #-} !k v !(PriorityQ k v) !(PriorityQ k v)
               deriving (Eq, Ord, Read, Show)

emptyPQ :: PriorityQ k v
emptyPQ = Lf

isEmptyPQ :: PriorityQ k v -> Bool
isEmptyPQ Lf  = True
isEmptyPQ _   = False

minKeyValuePQ :: PriorityQ k v -> (k, v)
minKeyValuePQ (Br k v _ _)    = (k,v)
minKeyValuePQ _               = error "Empty heap!"

minKeyPQ :: PriorityQ k v -> k
minKeyPQ (Br k v _ _)         = k
minKeyPQ _                    = error "Empty heap!"

minValuePQ :: PriorityQ k v -> v
minValuePQ (Br k v _ _)       = v
minValuePQ _                  = error "Empty heap!"

insertPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
insertPQ wk wv (Br vk vv t1 t2)
               | wk <= vk   = Br wk wv (insertPQ vk vv t2) t1
               | otherwise  = Br vk vv (insertPQ wk wv t2) t1
insertPQ wk wv Lf             = Br wk wv Lf Lf

siftdown :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v -> PriorityQ k v
siftdown wk wv Lf _             = Br wk wv Lf Lf
siftdown wk wv (t @ (Br vk vv _ _)) Lf
    | wk <= vk                  = Br wk wv t Lf
    | otherwise                 = Br vk vv (Br wk wv Lf Lf) Lf
siftdown wk wv (t1 @ (Br vk1 vv1 p1 q1)) (t2 @ (Br vk2 vv2 p2 q2))
    | wk <= vk1 && wk <= vk2    = Br wk wv t1 t2
    | vk1 <= vk2                = Br vk1 vv1 (siftdown wk wv p1 q1) t2
    | otherwise                 = Br vk2 vv2 t1 (siftdown wk wv p2 q2)

deleteMinAndInsertPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
deleteMinAndInsertPQ wk wv Lf             = error "Empty PriorityQ"
deleteMinAndInsertPQ wk wv (Br _ _ t1 t2) = siftdown wk wv t1 t2

leftrem :: PriorityQ k v -> (k, v, PriorityQ k v)
leftrem (Br vk vv Lf Lf) = (vk, vv, Lf)
leftrem (Br vk vv t1 t2) = (wk, wv, Br vk vv t t2) where
    (wk, wv, t) = leftrem t1
leftrem _                = error "Empty heap!"

deleteMinPQ :: Ord k => PriorityQ k v -> PriorityQ k v
deleteMinPQ (Br vk vv Lf _) = Lf
deleteMinPQ (Br vk vv t1 t2) = siftdown wk wv t2 t where
    (wk,wv,t) = leftrem t1
deleteMinPQ _ = error "Empty heap!"



toDescList :: Ord k => PriorityQ k v -> [(k,v)]
toDescList q | isEmptyPQ q = []
         | otherwise   = (minKeyValuePQ q) : toDescList (deleteMinPQ q)

fromList :: Ord k => [(k,v)] -> PriorityQ k v
fromList = foldr (uncurry insertPQ) emptyPQ



Here goes a test:

*PQ> let s = map fst . toDescList . fromList . (`zip` (repeat ())) ::
[Int]->[Int]
*PQ> s [4,3,1,2]
[1,2,3,4]

Looks fine.

*PQ> s [3,1,4,1,5,9,2,6,5,3,5,8]
[1,1,2*** Exception: Empty heap!

OK, probably it doesn't like duplicates.

*PQ> s [3,1,4,5,9,2,6,8,10]
[1,2,3,4,5,9,10]

Whoops, 6 and 8 are lost.

So, the morale is: don't use the priority queue from ONeillPrimes in
your projects. It works for primes by a lucky chance.

I haven't yet figured out, however, what exactly the bug is.

-- 
Eugene Kirpichov
Web IR developer, market.yandex.ru