{-# LANGUAGE TypeFamilies #-}

module Data.Heap.PairingHeap.Min where

import Data.Function
import qualified Data.List as L
import GHC.Exts

data MinHeap a = MinFork !a [MinHeap a] | MinEmpty

emptyMinPH :: MinHeap a
emptyMinPH :: forall a. MinHeap a
emptyMinPH = MinHeap a
forall a. MinHeap a
MinEmpty
{-# INLINE emptyMinPH #-}

singletonMinPH :: a -> MinHeap a
singletonMinPH :: forall a. a -> MinHeap a
singletonMinPH = (a -> [MinHeap a] -> MinHeap a) -> [MinHeap a] -> a -> MinHeap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [MinHeap a] -> MinHeap a
forall a. a -> [MinHeap a] -> MinHeap a
MinFork []
{-# INLINE singletonMinPH #-}

nullMinPH :: MinHeap a -> Bool
nullMinPH :: forall a. MinHeap a -> Bool
nullMinPH (MinFork a
_ [MinHeap a]
_) = Bool
False
nullMinPH MinHeap a
MinEmpty = Bool
True
{-# INLINE nullMinPH #-}

insertMinPH :: (Ord a) => a -> MinHeap a -> MinHeap a
insertMinPH :: forall a. Ord a => a -> MinHeap a -> MinHeap a
insertMinPH = MinHeap a -> MinHeap a -> MinHeap a
forall a. Ord a => MinHeap a -> MinHeap a -> MinHeap a
mergeMinPH (MinHeap a -> MinHeap a -> MinHeap a)
-> (a -> MinHeap a) -> a -> MinHeap a -> MinHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MinHeap a
forall a. a -> MinHeap a
singletonMinPH
{-# INLINE insertMinPH #-}

minElemPH :: MinHeap a -> Maybe a
minElemPH :: forall a. MinHeap a -> Maybe a
minElemPH (MinFork a
x [MinHeap a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
minElemPH MinHeap a
MinEmpty = Maybe a
forall a. Maybe a
Nothing
{-# INLINE minElemPH #-}

deleteMinPH :: (Ord a) => MinHeap a -> Maybe (MinHeap a)
deleteMinPH :: forall a. Ord a => MinHeap a -> Maybe (MinHeap a)
deleteMinPH (MinFork a
_ [MinHeap a]
hs) = MinHeap a -> Maybe (MinHeap a)
forall a. a -> Maybe a
Just (MinHeap a -> Maybe (MinHeap a)) -> MinHeap a -> Maybe (MinHeap a)
forall a b. (a -> b) -> a -> b
$! [MinHeap a] -> MinHeap a
forall a. Ord a => [MinHeap a] -> MinHeap a
mergePairsMinPH [MinHeap a]
hs
deleteMinPH MinHeap a
MinEmpty = Maybe (MinHeap a)
forall a. Maybe a
Nothing
{-# INLINE deleteMinPH #-}

deleteFindMinPH :: (Ord a) => MinHeap a -> Maybe (a, MinHeap a)
deleteFindMinPH :: forall a. Ord a => MinHeap a -> Maybe (a, MinHeap a)
deleteFindMinPH (MinFork a
x [MinHeap a]
hs) = case [MinHeap a] -> MinHeap a
forall a. Ord a => [MinHeap a] -> MinHeap a
mergePairsMinPH [MinHeap a]
hs of
  MinHeap a
merged -> (a, MinHeap a) -> Maybe (a, MinHeap a)
forall a. a -> Maybe a
Just (a
x, MinHeap a
merged)
deleteFindMinPH MinHeap a
MinEmpty = Maybe (a, MinHeap a)
forall a. Maybe a
Nothing
{-# INLINE deleteFindMinPH #-}

mergeMinPH :: (Ord a) => MinHeap a -> MinHeap a -> MinHeap a
mergeMinPH :: forall a. Ord a => MinHeap a -> MinHeap a -> MinHeap a
mergeMinPH hx :: MinHeap a
hx@(MinFork a
x [MinHeap a]
hxs) hy :: MinHeap a
hy@(MinFork a
y [MinHeap a]
hys)
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = a -> [MinHeap a] -> MinHeap a
forall a. a -> [MinHeap a] -> MinHeap a
MinFork a
x (MinHeap a
hy MinHeap a -> [MinHeap a] -> [MinHeap a]
forall a. a -> [a] -> [a]
: [MinHeap a]
hxs)
  | Bool
otherwise = a -> [MinHeap a] -> MinHeap a
forall a. a -> [MinHeap a] -> MinHeap a
MinFork a
y (MinHeap a
hx MinHeap a -> [MinHeap a] -> [MinHeap a]
forall a. a -> [a] -> [a]
: [MinHeap a]
hys)
mergeMinPH MinHeap a
MinEmpty MinHeap a
hy = MinHeap a
hy
mergeMinPH MinHeap a
hx MinHeap a
MinEmpty = MinHeap a
hx
{-# INLINE mergeMinPH #-}

mergePairsMinPH :: (Ord a) => [MinHeap a] -> MinHeap a
mergePairsMinPH :: forall a. Ord a => [MinHeap a] -> MinHeap a
mergePairsMinPH = [MinHeap a] -> MinHeap a
forall a. Monoid a => [a] -> a
mconcat ([MinHeap a] -> MinHeap a)
-> ([MinHeap a] -> [MinHeap a]) -> [MinHeap a] -> MinHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MinHeap a] -> [MinHeap a]
forall {a}. Semigroup a => [a] -> [a]
mergePairs
  where
    mergePairs :: [a] -> [a]
mergePairs (a
x : a
y : [a]
xs) = case a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y of
      a
merged -> a
merged a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
mergePairs [a]
xs
    mergePairs [a]
xs = [a]
xs
{-# INLINE mergePairsMinPH #-}

instance (Ord a) => Eq (MinHeap a) where
  == :: MinHeap a -> MinHeap a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool)
-> (MinHeap a -> [a]) -> MinHeap a -> MinHeap a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MinHeap a -> [a]
MinHeap a -> [Item (MinHeap a)]
forall l. IsList l => l -> [Item l]
toList

instance (Ord a) => Ord (MinHeap a) where
  compare :: MinHeap a -> MinHeap a -> Ordering
compare = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> Ordering)
-> (MinHeap a -> [a]) -> MinHeap a -> MinHeap a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MinHeap a -> [a]
MinHeap a -> [Item (MinHeap a)]
forall l. IsList l => l -> [Item l]
toList

instance (Ord a) => IsList (MinHeap a) where
  type Item (MinHeap a) = a
  fromList :: [Item (MinHeap a)] -> MinHeap a
fromList = [MinHeap a] -> MinHeap a
forall a. Ord a => [MinHeap a] -> MinHeap a
mergePairsMinPH ([MinHeap a] -> MinHeap a)
-> ([a] -> [MinHeap a]) -> [a] -> MinHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MinHeap a) -> [a] -> [MinHeap a]
forall a b. (a -> b) -> [a] -> [b]
map a -> MinHeap a
forall a. a -> MinHeap a
singletonMinPH
  toList :: MinHeap a -> [Item (MinHeap a)]
toList = (MinHeap a -> Maybe (a, MinHeap a)) -> MinHeap a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr MinHeap a -> Maybe (a, MinHeap a)
forall a. Ord a => MinHeap a -> Maybe (a, MinHeap a)
deleteFindMinPH

instance (Show a, Ord a) => Show (MinHeap a) where
  show :: MinHeap a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (MinHeap a -> [a]) -> MinHeap a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinHeap a -> [a]
MinHeap a -> [Item (MinHeap a)]
forall l. IsList l => l -> [Item l]
toList

instance (Ord a) => Semigroup (MinHeap a) where
  <> :: MinHeap a -> MinHeap a -> MinHeap a
(<>) = MinHeap a -> MinHeap a -> MinHeap a
forall a. Ord a => MinHeap a -> MinHeap a -> MinHeap a
mergeMinPH

instance (Ord a) => Monoid (MinHeap a) where
  mempty :: MinHeap a
mempty = MinHeap a
forall a. MinHeap a
emptyMinPH
  {-# INLINE mempty #-}