{-# LANGUAGE TypeFamilies #-}

module Data.Heap.PairingHeap.Max where

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

data MaxHeap a = MaxFork !a [MaxHeap a] | MaxEmpty

emptyMaxPH :: MaxHeap a
emptyMaxPH :: forall a. MaxHeap a
emptyMaxPH = MaxHeap a
forall a. MaxHeap a
MaxEmpty
{-# INLINE emptyMaxPH #-}

singletonMaxPH :: a -> MaxHeap a
singletonMaxPH :: forall a. a -> MaxHeap a
singletonMaxPH = (a -> [MaxHeap a] -> MaxHeap a) -> [MaxHeap a] -> a -> MaxHeap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [MaxHeap a] -> MaxHeap a
forall a. a -> [MaxHeap a] -> MaxHeap a
MaxFork []
{-# INLINE singletonMaxPH #-}

nullMaxPH :: MaxHeap a -> Bool
nullMaxPH :: forall a. MaxHeap a -> Bool
nullMaxPH (MaxFork a
_ [MaxHeap a]
_) = Bool
False
nullMaxPH MaxHeap a
MaxEmpty = Bool
True
{-# INLINE nullMaxPH #-}

insertMaxPH :: (Ord a) => a -> MaxHeap a -> MaxHeap a
insertMaxPH :: forall a. Ord a => a -> MaxHeap a -> MaxHeap a
insertMaxPH = MaxHeap a -> MaxHeap a -> MaxHeap a
forall a. Ord a => MaxHeap a -> MaxHeap a -> MaxHeap a
mergeMaxPH (MaxHeap a -> MaxHeap a -> MaxHeap a)
-> (a -> MaxHeap a) -> a -> MaxHeap a -> MaxHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MaxHeap a
forall a. a -> MaxHeap a
singletonMaxPH
{-# INLINE insertMaxPH #-}

maxElemPH :: MaxHeap a -> Maybe a
maxElemPH :: forall a. MaxHeap a -> Maybe a
maxElemPH (MaxFork a
x [MaxHeap a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
maxElemPH MaxHeap a
MaxEmpty = Maybe a
forall a. Maybe a
Nothing
{-# INLINE maxElemPH #-}

deleteMaxPH :: (Ord a) => MaxHeap a -> Maybe (MaxHeap a)
deleteMaxPH :: forall a. Ord a => MaxHeap a -> Maybe (MaxHeap a)
deleteMaxPH (MaxFork a
_ [MaxHeap a]
hs) = MaxHeap a -> Maybe (MaxHeap a)
forall a. a -> Maybe a
Just (MaxHeap a -> Maybe (MaxHeap a)) -> MaxHeap a -> Maybe (MaxHeap a)
forall a b. (a -> b) -> a -> b
$! [MaxHeap a] -> MaxHeap a
forall a. Ord a => [MaxHeap a] -> MaxHeap a
mergePairsMaxPH [MaxHeap a]
hs
deleteMaxPH MaxHeap a
MaxEmpty = Maybe (MaxHeap a)
forall a. Maybe a
Nothing
{-# INLINE deleteMaxPH #-}

deleteFindMaxPH :: (Ord a) => MaxHeap a -> Maybe (a, MaxHeap a)
deleteFindMaxPH :: forall a. Ord a => MaxHeap a -> Maybe (a, MaxHeap a)
deleteFindMaxPH (MaxFork a
x [MaxHeap a]
hs) = case [MaxHeap a] -> MaxHeap a
forall a. Ord a => [MaxHeap a] -> MaxHeap a
mergePairsMaxPH [MaxHeap a]
hs of
  MaxHeap a
merged -> (a, MaxHeap a) -> Maybe (a, MaxHeap a)
forall a. a -> Maybe a
Just (a
x, MaxHeap a
merged)
deleteFindMaxPH MaxHeap a
MaxEmpty = Maybe (a, MaxHeap a)
forall a. Maybe a
Nothing
{-# INLINE deleteFindMaxPH #-}

mergeMaxPH :: (Ord a) => MaxHeap a -> MaxHeap a -> MaxHeap a
mergeMaxPH :: forall a. Ord a => MaxHeap a -> MaxHeap a -> MaxHeap a
mergeMaxPH hx :: MaxHeap a
hx@(MaxFork a
x [MaxHeap a]
hxs) hy :: MaxHeap a
hy@(MaxFork a
y [MaxHeap a]
hys)
  | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x = a -> [MaxHeap a] -> MaxHeap a
forall a. a -> [MaxHeap a] -> MaxHeap a
MaxFork a
x (MaxHeap a
hy MaxHeap a -> [MaxHeap a] -> [MaxHeap a]
forall a. a -> [a] -> [a]
: [MaxHeap a]
hxs)
  | Bool
otherwise = a -> [MaxHeap a] -> MaxHeap a
forall a. a -> [MaxHeap a] -> MaxHeap a
MaxFork a
y (MaxHeap a
hx MaxHeap a -> [MaxHeap a] -> [MaxHeap a]
forall a. a -> [a] -> [a]
: [MaxHeap a]
hys)
mergeMaxPH MaxHeap a
MaxEmpty MaxHeap a
hy = MaxHeap a
hy
mergeMaxPH MaxHeap a
hx MaxHeap a
MaxEmpty = MaxHeap a
hx
{-# INLINE mergeMaxPH #-}

mergePairsMaxPH :: (Ord a) => [MaxHeap a] -> MaxHeap a
mergePairsMaxPH :: forall a. Ord a => [MaxHeap a] -> MaxHeap a
mergePairsMaxPH = [MaxHeap a] -> MaxHeap a
forall a. Monoid a => [a] -> a
mconcat ([MaxHeap a] -> MaxHeap a)
-> ([MaxHeap a] -> [MaxHeap a]) -> [MaxHeap a] -> MaxHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaxHeap a] -> [MaxHeap 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 mergePairsMaxPH #-}

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

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

instance (Ord a) => IsList (MaxHeap a) where
  type Item (MaxHeap a) = a
  fromList :: [Item (MaxHeap a)] -> MaxHeap a
fromList = [MaxHeap a] -> MaxHeap a
forall a. Ord a => [MaxHeap a] -> MaxHeap a
mergePairsMaxPH ([MaxHeap a] -> MaxHeap a)
-> ([a] -> [MaxHeap a]) -> [a] -> MaxHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MaxHeap a) -> [a] -> [MaxHeap a]
forall a b. (a -> b) -> [a] -> [b]
map a -> MaxHeap a
forall a. a -> MaxHeap a
singletonMaxPH
  toList :: MaxHeap a -> [Item (MaxHeap a)]
toList = (MaxHeap a -> Maybe (a, MaxHeap a)) -> MaxHeap a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr MaxHeap a -> Maybe (a, MaxHeap a)
forall a. Ord a => MaxHeap a -> Maybe (a, MaxHeap a)
deleteFindMaxPH

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

instance (Ord a) => Semigroup (MaxHeap a) where
  <> :: MaxHeap a -> MaxHeap a -> MaxHeap a
(<>) = MaxHeap a -> MaxHeap a -> MaxHeap a
forall a. Ord a => MaxHeap a -> MaxHeap a -> MaxHeap a
mergeMaxPH

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