Am Dienstag, 24. Februar 2009 19:16 schrieb 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.
Indeed.
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.
That is not the problem.
*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.
The problem is that deleteMinPQ and siftdown assume that if the left subqueue is empty then so is the right, but that assumption is sometimes wrong: *PQ> fromList [(k,k) | k <- [1 .. 7]] Br 1 1 (Br 2 2 (Br 4 4 Lf Lf) (Br 6 6 Lf Lf)) (Br 3 3 (Br 5 5 Lf Lf) (Br 7 7 Lf Lf)) *PQ> deleteMinPQ it Br 2 2 (Br 3 3 (Br 5 5 Lf Lf) (Br 7 7 Lf Lf)) (Br 4 4 Lf Lf) *PQ> deleteMinPQ it Br 3 3 (Br 4 4 Lf Lf) (Br 5 5 Lf Lf) *PQ> deleteMinPQ it Br 4 4 (Br 5 5 Lf Lf) Lf *PQ> deleteMinPQ it Br 5 5 Lf Lf *PQ> deleteMinPQ it Lf