-- |
-- Module     : Simulation.Aivika.PriorityQueue.Pure
-- Copyright  : Copyright (c) 2015-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- An immutable heap-based priority queue based on book
-- Algorithms: A Functional Programming Approach by
-- Fethi Rabhi and Guy Lapalme.
--
module Simulation.Aivika.PriorityQueue.Pure 
       (PriorityQueue, 
        queueNull, 
        queueCount,
        emptyQueue, 
        enqueue, 
        dequeue, 
        queueFront) where 

import Control.Monad

-- | The 'PriorityQueue' type represents an immutable heap-based priority queue.
data PriorityQueue a = EmptyQueue
                     | Queue !Int !Double a !Int (PriorityQueue a) (PriorityQueue a)
                       deriving Int -> PriorityQueue a -> ShowS
[PriorityQueue a] -> ShowS
PriorityQueue a -> String
(Int -> PriorityQueue a -> ShowS)
-> (PriorityQueue a -> String)
-> ([PriorityQueue a] -> ShowS)
-> Show (PriorityQueue a)
forall a. Show a => Int -> PriorityQueue a -> ShowS
forall a. Show a => [PriorityQueue a] -> ShowS
forall a. Show a => PriorityQueue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PriorityQueue a] -> ShowS
$cshowList :: forall a. Show a => [PriorityQueue a] -> ShowS
show :: PriorityQueue a -> String
$cshow :: forall a. Show a => PriorityQueue a -> String
showsPrec :: Int -> PriorityQueue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PriorityQueue a -> ShowS
Show

-- | Test whether the priority queue is empty.
queueNull :: PriorityQueue a -> Bool
queueNull :: PriorityQueue a -> Bool
queueNull PriorityQueue a
EmptyQueue = Bool
True
queueNull PriorityQueue a
_          = Bool
False

-- | Return the number of elements in the priority queue.
queueCount :: PriorityQueue a -> Int
queueCount :: PriorityQueue a -> Int
queueCount PriorityQueue a
EmptyQueue = Int
0
queueCount (Queue Int
n Double
k a
v Int
r PriorityQueue a
a PriorityQueue a
b) = Int
n

-- | An empty priority queue.
emptyQueue :: PriorityQueue a
emptyQueue :: PriorityQueue a
emptyQueue = PriorityQueue a
forall a. PriorityQueue a
EmptyQueue

-- | Enqueue a new element with the specified priority.
enqueue :: PriorityQueue a -> Double -> a -> PriorityQueue a
enqueue :: PriorityQueue a -> Double -> a -> PriorityQueue a
enqueue PriorityQueue a
pq Double
k a
v = PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
pq (Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Int
1 Double
k a
v Int
1 PriorityQueue a
forall a. PriorityQueue a
EmptyQueue PriorityQueue a
forall a. PriorityQueue a
EmptyQueue)

-- | Dequeue the element with the minimal priority.
dequeue :: PriorityQueue a -> PriorityQueue a
dequeue :: PriorityQueue a -> PriorityQueue a
dequeue PriorityQueue a
EmptyQueue = String -> PriorityQueue a
forall a. HasCallStack => String -> a
error String
"The queue is empty: dequeue"
dequeue (Queue Int
n Double
k a
v Int
r PriorityQueue a
a PriorityQueue a
b) = PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
a PriorityQueue a
b

-- | Return the element with the minimal priority.
queueFront :: PriorityQueue a -> (Double, a)
queueFront :: PriorityQueue a -> (Double, a)
queueFront PriorityQueue a
EmptyQueue = String -> (Double, a)
forall a. HasCallStack => String -> a
error String
"The queue is empty: queueFront"
queueFront (Queue Int
n Double
k a
v Int
r PriorityQueue a
a PriorityQueue a
b) = (Double
k, a
v)

-- | Return the rank of the priority queue.
queueRank :: PriorityQueue a -> Int
queueRank :: PriorityQueue a -> Int
queueRank PriorityQueue a
EmptyQueue = Int
0
queueRank (Queue Int
n Double
k a
v Int
r PriorityQueue a
a PriorityQueue a
b) = Int
r

-- | Construct a new priority queue.
makeQueue :: Double -> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
makeQueue :: Double
-> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
makeQueue Double
k a
v PriorityQueue a
a PriorityQueue a
b
  | PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueRank PriorityQueue a
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueRank PriorityQueue a
b = Int
n Int -> PriorityQueue a -> PriorityQueue a
`seq` Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Int
n Double
k a
v (PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueRank PriorityQueue a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PriorityQueue a
a PriorityQueue a
b
  | Bool
otherwise                  = Int
n Int -> PriorityQueue a -> PriorityQueue a
`seq` Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Int
-> Double
-> a
-> Int
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Int
n Double
k a
v (PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueRank PriorityQueue a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PriorityQueue a
b PriorityQueue a
a
  where n :: Int
n = PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueCount PriorityQueue a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PriorityQueue a -> Int
forall a. PriorityQueue a -> Int
queueCount PriorityQueue a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Merge two priority queues.
mergeQueues :: PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues :: PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
h PriorityQueue a
EmptyQueue = PriorityQueue a
h
mergeQueues PriorityQueue a
EmptyQueue PriorityQueue a
h = PriorityQueue a
h
mergeQueues h1 :: PriorityQueue a
h1@(Queue Int
_ Double
k1 a
v1 Int
_ PriorityQueue a
a1 PriorityQueue a
b1) h2 :: PriorityQueue a
h2@(Queue Int
_ Double
k2 a
v2 Int
_ PriorityQueue a
a2 PriorityQueue a
b2)
  | Double
k1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
k2  = Double
-> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a.
Double
-> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
makeQueue Double
k1 a
v1 PriorityQueue a
a1 (PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
b1 PriorityQueue a
h2)
  | Bool
otherwise = Double
-> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a.
Double
-> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
makeQueue Double
k2 a
v2 PriorityQueue a
a2 (PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
h1 PriorityQueue a
b2)