aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Time for an 2014 update…

Browse source
This commit is contained in:
Ingy döt Net 2014-01-17 05:32:22 +00:00
parent 372c577f83
commit 09687c4926
2520 changed files with 34227 additions and 7318 deletions
Download patch file Download diff file Expand all files Collapse all files

42
Task/Priority-queue/Haskell/priority-queue-2.hs
View file

@ -1,27 +1,27 @@
data MinHeap a = Nil | MinHeap { v::a, cnt::Int, l::MinHeap a, r::MinHeap a }
deriving (Show, Eq)
deriving (Show, Eq)
hPush :: (Ord a) => a -> MinHeap a -> MinHeap a
hPush x Nil = MinHeap {v = x, cnt = 1, l = Nil, r = Nil}
hPush x h = if x < vv -- insert element, try to keep the tree balanced
then if hLength (l h) <= hLength (r h)
then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
else if hLength (l h) <= hLength (r h)
then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)
then if hLength (l h) <= hLength (r h)
then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
else if hLength (l h) <= hLength (r h)
then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)
hPop :: (Ord a) => MinHeap a -> (a, MinHeap a)
hPop h = (v h, pq) where -- just pop, heed not the tree balance
pq | l h == Nil = r h
| r h == Nil = l h
| v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
MinHeap {v = vv, cnt = hLength hh + hLength (r h),
l = hh, r = r h}
| otherwise = let (vv,hh) = hPop (r h) in
MinHeap {v = vv, cnt = hLength hh + hLength (l h),
l = l h, r = hh}
pq | l h == Nil = r h
| r h == Nil = l h
| v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
MinHeap {v = vv, cnt = hLength hh + hLength (r h),
l = hh, r = r h}
| otherwise = let (vv,hh) = hPop (r h) in
MinHeap {v = vv, cnt = hLength hh + hLength (l h),
l = l h, r = hh}
hLength :: (Ord a) => MinHeap a -> Int
hLength Nil = 0
@ -36,8 +36,8 @@ hToList = unfoldr f where
f h = Just $ hPop h
main = mapM_ print $ hToList $ hFromList [
(3, "Clear drains"),
(4, "Feed cat"),
(5, "Make tea"),
(1, "Solve RC tasks"),
(2, "Tax return")]
(3, "Clear drains"),
(4, "Feed cat"),
(5, "Make tea"),
(1, "Solve RC tasks"),
(2, "Tax return")]